Re: flags object from strings

[Torsten Schoenfeld <kaffeetisch gmx de>]

muppet wrote:

> > Some code below.  It runs, but dunno if I understand the subtleties of
> > classname to gtype conversion.
>
> I think the lookup is fine, though the message may be confusing if you
> use Gtk2::Widget or some other valid GType which isn't a flags type.

Here's an updated patch that incorporates Kevin's original patch and
your test cases.  It also changes the error message to be more specific,
and to occur when the type is not a G_TYPE_FLAGS descendant, and it
alters the tests to not use is() directly on flags values.

Commit?

-- 
Bye,
-Torsten

Index: GType.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GType.xs,v
retrieving revision 1.88
diff -u -d -p -r1.88 GType.xs
--- GType.xs    4 May 2008 12:49:53 -0000       1.88
+++ GType.xs    20 May 2008 18:39:07 -0000
@@ -2678,6 +2678,35 @@ Now That" section of L<Glib> for more in
 =cut
 
 =for apidoc
+Create a new flags object with given bits.  This is for use from a
+subclass, it's not possible to create a C<Glib::Flags> object as such.
+For example,
+
+    my $f1 = Glib::ParamFlags->new ('readable');
+    my $f2 = Glib::ParamFlags->new (['readable','writable']);
+
+An object like this can then be used with the overloaded operators.
+=cut
+SV *
+new (const char *class, SV *a)
+    PREINIT:
+       GType gtype;
+    CODE:
+       gtype = gperl_fundamental_type_from_package (class);
+       if (! gtype || ! g_type_is_a (gtype, G_TYPE_FLAGS)) {
+               croak ("package %s is not registered with the GLib type system"
+                      "as a flags type",
+                      class);
+       }
+       if (gtype == G_TYPE_FLAGS) {
+               croak ("cannot create Glib::Flags (only subclasses)");
+       }
+       RETVAL = gperl_convert_back_flags
+                       (gtype, gperl_convert_flags (gtype, a));
+    OUTPUT:
+       RETVAL
+
+=for apidoc
 =for arg b (SV*)
 =for arg swap (integer)
 =cut
Index: t/c.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/t/c.t,v
retrieving revision 1.9
diff -u -d -p -r1.9 c.t
--- t/c.t       4 May 2008 12:38:55 -0000       1.9
+++ t/c.t       20 May 2008 18:39:07 -0000
@@ -12,11 +12,35 @@ use warnings;
 
 #########################
 
-use Test::More tests => 17;
+use Test::More tests => 26;
 BEGIN { use_ok('Glib') };
 
 #########################
 
+#
+# Flags basics
+#
+
+my $f = Glib::ParamFlags->new (['readable', 'writable']); # with array
+isa_ok ($f, 'Glib::Flags');
+isa_ok ($f, 'Glib::ParamFlags');
+ok ($f == ['readable', 'writable'], "value");
+
+$f = Glib::ParamFlags->new ('readable'); # with plain string
+isa_ok ($f, 'Glib::Flags');
+isa_ok ($f, 'Glib::ParamFlags');
+ok ($f == ['readable'], "value");
+
+my $g = Glib::ParamFlags->new ($f + 'writable'); # from another
+isa_ok ($g, 'Glib::ParamFlags');
+ok ($g >= $f);
+
+$@ = undef;
+eval { my $h = Glib::Flags->new (['readable']); };
+ok ($@, "Will croak on trying to create plain old Glib::Flags");
+
+#########################
+
 $@ = undef;
 eval {
        Glib::Type->register_enum ('TestEnum', 
@@ -169,6 +193,10 @@ sub sig1
 
 package main;
 
+#
+# App-registered flags.
+#
+
 my $obj = Tester->new;
 $obj->sig1 ('value-two', ['value-one', 'value-two']);