Re: GLib/perl and GArray, GType

[Torsten Schoenfeld <kaffeetisch gmx de>]

Wouter Verhelst wrote:
> > I seem to be misunderstanding the GParamSpecGType docs when they talk  
> > about how is_a_type works when it's G_TYPE_NONE.

I don't quite understand what you're talking about here, muppet.  The test cases 
in your patch all work fine for me, even those that are commented out can be 
made to work.  I attach an updated patch with more tests.  Commit?

> Doesn't seem to work the way it should. When I do this:
>
> $model->set("type" => "Nspos::Db::Order");
>
> the warning message looks like this:
>
> Glib-GObject-WARNING **: value "((gpointer) 0x1c)" of type `GType' is invalid or out of range for property 
> `type' of type `GType' at (...)

This is the error message you get when you try set a GType property to a GType 
that is not a descendant of the GType property's is_a_type (that is, the fourth 
argument to Glib::ParamSpec->gtype).  So, in your example, it seems that 
"Nspos::Db::Order" is not a descendant of "type"'s is_a_type -- at least as far 
as Glib's type system is concerned.
Index: GParamSpec.xs
===================================================================
--- GParamSpec.xs       (revision 1083)
+++ GParamSpec.xs       (working copy)
@@ -263,6 +263,9 @@ BOOT:
 #if GLIB_CHECK_VERSION(2,4,0)
        gperl_register_param_spec (G_TYPE_PARAM_OVERRIDE, "Glib::Param::Override");
 #endif
+#if GLIB_CHECK_VERSION(2,10,0)
+       gperl_register_param_spec (G_TYPE_PARAM_GTYPE, "Glib::Param::GType");
+#endif
 
 =for enum Glib::ParamFlags
 =cut
@@ -569,6 +572,23 @@ scalar (class, name, nick, blurb, flags)
 ###  GParamSpec* g_param_spec_value_array (const gchar *name, const gchar *nick, const gchar *blurb, 
GParamSpec *element_spec, GParamFlags flags) 
 
 
+#if GLIB_CHECK_VERSION(2, 10, 0)
+
+=for apidoc
+=for arg is_a_type  The name of a class whose subtypes are allowed as values of the property.  Use C<undef> 
to allow any type.
+=cut
+GParamSpec*
+g_param_spec_gtype (class, name, nick, blurb, is_a_type, flags)
+       const gchar *name
+       const gchar *nick
+       const gchar *blurb
+       const gchar_ornull *is_a_type
+       GParamFlags flags
+    C_ARGS:
+       name, nick, blurb, is_a_type ? gperl_type_from_package (is_a_type) : G_TYPE_NONE, flags
+
+#endif
+
 
 ####
 #### accessors
@@ -1198,3 +1218,36 @@ get_default_value (GParamSpec * pspec_un
 ## G_TYPE_PARAM_POINTER, "Glib::Param::Pointer" -- no members
 ## G_TYPE_PARAM_OBJECT, "Glib::Param::Object" -- no members
 ## G_TYPE_PARAM_OVERRIDE, "Glib::Param::Override" -- no public members
+
+
+MODULE = Glib::ParamSpec       PACKAGE = Glib::Param::GType
+
+#if GLIB_CHECK_VERSION(2, 10, 0)
+
+=for section DESCRIPTION
+
+=head1 DESCRIPTION
+
+This object describes a parameter which holds the name of a class known to the
+GLib type system.  The name of the class is considered to be the common
+ancestor for valid values.  To create a param that allows any type name,
+specify C<undef> for the package name.  Beware, however, that although
+we say "any type name", this actually refers to any type registered
+with Glib; normal Perl packages will not work.
+
+=cut
+
+=for apidoc
+If C<undef>, then any class is allowed.
+=cut
+const gchar_ornull *
+is_a_type (GParamSpec * pspec_gtype)
+    CODE:
+       GParamSpecGType * p = G_PARAM_SPEC_GTYPE (pspec_gtype);
+       RETVAL = p->is_a_type == G_TYPE_NONE
+               ? NULL
+               : gperl_package_from_type (p->is_a_type);
+    OUTPUT:
+       RETVAL
+
+#endif
Index: t/e.t
===================================================================
--- t/e.t       (revision 1083)
+++ t/e.t       (working copy)
@@ -5,7 +5,7 @@
 use strict;
 use utf8;
 use Glib ':constants';
-use Test::More tests => 243;
+use Test::More tests => 259;
 
 # first register some types with which to play below.
 
@@ -210,6 +210,56 @@ foreach (@params) {
 
 
 #
+# Since this is conditional on version, we don't want to overcomplicate
+# the testing logic above.
+#
+SKIP: {
+       skip "GParamSpecGType is new in glib 2.10.0", 16
+               unless Glib->CHECK_VERSION (2, 10, 0);
+       @params = ();
+
+       $pspec = Glib::ParamSpec->gtype ('object', 'Object Type',
+                                        "Any object type",
+                                        Glib::Object::,
+                                        G_PARAM_READWRITE);
+       isa_ok ($pspec, 'Glib::Param::GType');
+       isa_ok ($pspec, 'Glib::ParamSpec');
+       is ($pspec->is_a_type, 'Glib::Object');
+       push @params, $pspec;
+
+       $pspec = Glib::ParamSpec->gtype ('type', 'Any type', "Any type",
+                                        undef, G_PARAM_READWRITE);
+       isa_ok ($pspec, 'Glib::Param::GType');
+       isa_ok ($pspec, 'Glib::ParamSpec');
+       is ($pspec->is_a_type, undef);
+       push @params, $pspec;
+
+       Glib::Type->register ('Glib::Object' => 'Baz', properties => \ params);
+
+       my $baz = Glib::Object::new ('Baz');
+       isa_ok ($baz, 'Glib::Object');
+       is ($baz->get ('object'), undef);
+       is ($baz->get ('type'), undef);
+
+       $baz = Glib::Object::new ('Baz', object => 'Bar', type => 'Glib::ParamSpec');
+       isa_ok ($baz, 'Glib::Object');
+       is ($baz->get ('object'), 'Bar');
+       is ($baz->get ('type'), 'Glib::ParamSpec');
+
+       $baz->set (type => 'Bar');
+       is ($baz->get ('type'), 'Bar');
+       $baz->set (type => 'Glib::ParamSpec');
+       is ($baz->get ('type'), 'Glib::ParamSpec');
+
+        $baz->set (object => 'Glib::Object');
+       is ($baz->get ('object'), 'Glib::Object');
+        $baz->set (object => 'Glib::InitiallyUnowned');
+       is ($baz->get ('object'), 'Glib::InitiallyUnowned');
+}
+
+
+
+#
 # verify that NULL param specs are handled gracefully
 #
 
Index: GValue.xs
===================================================================
--- GValue.xs   (revision 1083)
+++ GValue.xs   (working copy)
@@ -1,6 +1,6 @@
 /*
- * Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for
- * the full list)
+ * Copyright (C) 2003-2009 by the gtk2-perl team (see the file AUTHORS for the
+ * full list)
  *
  * This library is free software; you can redistribute it and/or modify it
  * under the terms of the GNU Library General Public License as published by
@@ -118,6 +118,15 @@ gperl_value_from_sv (GValue * value,
                        g_value_set_string(value, SvGChar(sv));
                        break;
                case G_TYPE_POINTER:
+#if GLIB_CHECK_VERSION(2, 10, 0)
+                       /* The fundamental type for G_TYPE_GTYPE is
+                        * G_TYPE_POINTER, so we have to treat this
+                        * specially. */
+                       if (G_VALUE_TYPE (value) == G_TYPE_GTYPE) {
+                               g_value_set_gtype (value, gperl_type_from_package (SvGChar (sv)));
+                               break;
+                       }
+#endif
                        g_value_set_pointer (value,
                                             INT2PTR (gpointer, SvIV (sv)));
                        break;
@@ -222,6 +231,18 @@ _gperl_sv_from_value_internal (const GVa
                        return newSVGChar (g_value_get_string (value));
 
                case G_TYPE_POINTER:
+#if GLIB_CHECK_VERSION(2, 10, 0)
+                       /* The fundamental type for G_TYPE_GTYPE is
+                        * G_TYPE_POINTER, so we have to treat this
+                        * specially. */
+                       if (G_VALUE_TYPE (value) == G_TYPE_GTYPE) {
+                               GType gtype = g_value_get_gtype (value);
+                               return newSVGChar (
+                                 gtype == G_TYPE_NONE
+                                        ? NULL
+                                        : gperl_package_from_type (gtype));
+                       }
+#endif
                        return newSViv (PTR2IV (g_value_get_pointer (value)));
 
                case G_TYPE_BOXED: