Commit 361ba7d5 authored by Torsten Schönfeld's avatar Torsten Schönfeld
Browse files

Install constant numeric subs for all enum and flags values

Install, for example, a constant sub Glib::IOCondition::HUP returning
the number 16.

This is useful when a function, signal or property expects or returns an
enum or flags value, but the API specification is such that our special
enum and flags string handlers are not invoked.  Example:
Gtk3::TextTag's "weight" property accepts any positive integer but
predefined values are given by the Pango::Weight enum.
parent 49067b4f
......@@ -41,6 +41,10 @@ G_LOCK_DEFINE_STATIC (types_by_package);
G_LOCK_DEFINE_STATIC (packages_by_type);
G_LOCK_DEFINE_STATIC (wrapper_class_by_type);
/* pre-declarations */
static void gperl_type_enum_install_constants (GType flags_type, const char *package);
static void gperl_type_flags_install_constants (GType flags_type, const char *package);
/*
* this is just like gtk_type_class --- it keeps a reference on the classes
* it returns so they stick around. this is most important for enums and
......@@ -109,8 +113,12 @@ gperl_register_fundamental (GType gtype, const char * package)
G_UNLOCK (types_by_package);
G_UNLOCK (packages_by_type);
if (g_type_is_a (gtype, G_TYPE_FLAGS) && gtype != G_TYPE_FLAGS)
if (g_type_is_a (gtype, G_TYPE_ENUM) && gtype != G_TYPE_ENUM) {
gperl_type_enum_install_constants (gtype, package);
} else if (g_type_is_a (gtype, G_TYPE_FLAGS) && gtype != G_TYPE_FLAGS) {
gperl_type_flags_install_constants (gtype, package);
gperl_set_isa (package, "Glib::Flags");
}
}
=item void gperl_register_fundamental_alias (GType gtype, const char * package)
......@@ -311,6 +319,51 @@ gperl_type_flags_get_values (GType flags_type)
}
static void
gperl_type_enum_install_constants (GType enum_type, const char *package)
{
HV *stash;
GEnumValue * vals;
g_return_if_fail (G_TYPE_IS_ENUM (enum_type));
stash = gv_stashpv (package, GV_ADD);
vals = gperl_type_enum_get_values (enum_type);
while (vals && vals->value_name && vals->value_nick) {
char *tmp, *constant_name = g_ascii_strup (vals->value_nick, -1);
for (tmp = constant_name; *tmp != '\0'; tmp++) {
if (*tmp == '-') *tmp = '_';
}
/* The new sub takes ownership of the SV. */
newCONSTSUB (stash, constant_name, newSViv (vals->value));
g_free (constant_name);
vals++;
}
}
static void
gperl_type_flags_install_constants (GType flags_type, const char *package)
{
HV *stash;
GFlagsValue * vals;
g_return_if_fail (G_TYPE_IS_FLAGS (flags_type));
stash = gv_stashpv (package, GV_ADD);
vals = gperl_type_flags_get_values (flags_type);
while (vals && vals->value_name && vals->value_nick) {
char *tmp, *constant_name = g_ascii_strup (vals->value_nick, -1);
for (tmp = constant_name; *tmp != '\0'; tmp++) {
if (*tmp == '-') *tmp = '_';
}
/* The new sub takes ownership of the SV. */
newCONSTSUB (stash, constant_name, newSVuv (vals->value));
g_free (constant_name);
vals++;
}
}
=item gboolean gperl_try_convert_enum (GType gtype, SV * sv, gint * val)
return FALSE if I<sv> can't be mapped to a valid member of the registered
......@@ -325,18 +378,36 @@ gperl_try_convert_enum (GType type,
SV * sv,
gint * val)
{
GEnumValue * vals;
char *val_p = SvPV_nolen(sv);
GEnumValue * vals, * vals_iter;
char *val_p;
gint val_i;
/* first, try as a string */
val_p = SvPV_nolen(sv);
if (*val_p == '-') val_p++;
vals = gperl_type_enum_get_values (type);
while (vals && vals->value_nick && vals->value_name) {
if (gperl_str_eq (val_p, vals->value_nick) ||
gperl_str_eq (val_p, vals->value_name)) {
*val = vals->value;
vals_iter = vals;
while (vals_iter && vals_iter->value_nick && vals_iter->value_name) {
if (gperl_str_eq (val_p, vals_iter->value_nick) ||
gperl_str_eq (val_p, vals_iter->value_name)) {
*val = vals_iter->value;
return TRUE;
}
vals++;
vals_iter++;
}
/* then, try again as an integer */
val_i = SvIV (sv);
vals_iter = vals;
while (vals_iter && vals_iter->value_nick && vals_iter->value_name) {
if (vals_iter->value == val_i) {
*val = vals_iter->value;
return TRUE;
}
vals_iter++;
}
/* give up */
return FALSE;
}
......@@ -436,6 +507,45 @@ gperl_try_convert_flag (GType type,
}
vals++;
}
return FALSE;
}
static int
uint_inv_compare (gconstpointer a, gconstpointer b)
{
guint int_a = * ((guint *) a);
guint int_b = * ((guint *) b);
return - (int_a - int_b);
}
static gboolean
gperl_check_flag_int (GType type,
guint val_i)
{
GFlagsValue * vals;
guint i, remainder = val_i;
GArray *vals_i;
vals = gperl_type_flags_get_values (type);
vals_i = g_array_new (FALSE, FALSE, sizeof (guint));
while (vals && vals->value_nick && vals->value_name) {
g_array_append_val (vals_i, vals->value);
vals++;
}
g_array_sort (vals_i, uint_inv_compare);
for (i = 0; i < vals_i->len; i++) {
guint candidate = g_array_index (vals_i, guint, i);
if (candidate <= remainder) {
remainder -= candidate;
}
if (remainder == 0) {
return TRUE;
}
}
g_array_free (vals_i, TRUE);
return FALSE;
}
......@@ -497,6 +607,12 @@ gperl_convert_flags (GType type,
}
if (SvPOK (val))
return gperl_convert_flag_one (type, SvPV_nolen (val));
if (SvIOK (val) || SvUOK (val) || SvNOK (val)) {
guint val_i = SvUV (val);
if (gperl_check_flag_int (type, val_i)) {
return val_i;
}
}
croak ("FATAL: invalid %s value %s, expecting a string scalar or an arrayref of strings",
g_type_name (type), SvPV_nolen (val));
......
......@@ -508,6 +508,15 @@ access the flag values directly as strings (but you are not allowed to
modify the array), and when stringified C<"$flags"> a flags value will
output a human-readable version of its contents.
Normally, there is no need to access the underlying numeric values of enum or
flags values. But for the rare cases where the numeric values are required,
they are provided as constant subs accessible as C<Package::NICK_NAME> where
the package is the one associated with the enum or flags, e.g.,
"Glib::SpawnFlags", and the sub name is the nick name in upper case with '-'
replaced by '_', e.g., "LEAVE_DESCRIPTORS_OPEN". So the numeric value of
G_SPAWN_LEAVE_DESCRIPTORS_OPEN is accessible as
C<Glib::SpawnFlags::LEAVE_DESCRIPTORS_OPEN>.
=head2 It's All the Same
For the most part, the remaining bits of GLib are unchanged. GMainLoop is now
......
......@@ -10,10 +10,11 @@
use strict;
use warnings;
use List::Util qw/sum/;
#########################
use Test::More tests => 57;
use Test::More tests => 125;
BEGIN { use_ok('Glib') };
#########################
......@@ -262,6 +263,62 @@ ok ($obj->get ('some_flags') != [qw/value-one/], '!= is overloaded');
ok ($obj->get ('some_flags') eq [qw/value-one value-two/], 'eq is overloaded');
ok ($obj->get ('some_flags') ne [qw/value-one/], 'ne is overloaded');
#
# Constants
#
{
no strict 'refs';
# Use numeric constants for an enum type.
my $obj = Tester->new;
$obj->set (some_enum => TestEnum::VALUE_TWO ());
is ($obj->get ('some_enum'), 'value-two',
'enum property, TestEnum::VALUE_TWO => value-two');
{
local $@;
eval { $obj->set (some_enum => 7); };
like ($@, qr/invalid/, 'enum property, invalid value dies');
}
# Use numeric constants for a flags type. Try all possible combinations.
# http://stackoverflow.com/questions/994235/how-can-i-generate-all-subsets-of-a-list-in-perl
my @flag_values = (TestFlags::VALUE_ONE (),
TestFlags::VALUE_TWO (),
TestFlags::VALUE_THREE (),
TestFlags::VALUE_FOUR (),
TestFlags::VALUE_FIVE (),
TestFlags::VALUE_SIX ());
foreach my $count (1 .. (1<<@flag_values)-1) {
my $flags = [ map $count & (1<<$_) ? $flag_values[$_] : (), 0..$#flag_values ];
my $flags_i = sum @$flags;
$obj->set (some_flags => $flags_i);
ok ($obj->get ('some_flags') == $flags_i,
"flags property, $flags_i OK");
}
{
local $@;
eval { $obj->set (some_flags => 2**3); };
like ($@, qr/invalid/, 'flags property, invalid value dies');
}
# Compare constants for a flags type.
my @value_infos = Glib::Type->list_values ('Glib::IOCondition');
my @subs = map { my $n = $_->{nick}; $n =~ s/-/_/g; uc $n } @value_infos;
my @values = map { $_->{value} } @value_infos;
is_deeply ([map { *{'Glib::IOCondition::' . $_}->() } @subs], \@values,
'Glib::IOCondition: the constants and Glib::Type->list_values agree');
skip 'new 2.14 stuff', 1
unless Glib->CHECK_VERSION (2, 14, 0);
# Compore constants for an enum type.
@value_infos = Glib::Type->list_values ('Glib::UserDirectory');
@subs = map { my $n = $_->{nick}; $n =~ s/-/_/g; uc $n } @value_infos;
@values = map { $_->{value} } @value_infos;
is_deeply ([map { *{'Glib::UserDirectory::' . $_}->() } @subs], \@values,
'Glib::UserDirectory: the constants and Glib::Type->list_values agree');
}
__END__
Copyright (C) 2003-2005, 2009 by the gtk2-perl team (see the file AUTHORS for the
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment