flags overload funcs on non-reference

[Kevin Ryde <user42 zip com au>]

While contemplating the flags overload funcs I noticed a bad call like

    use Glib;
    Glib::Flags::as_arrayref(undef,0,0);

gets a segfault.  It'd be unusual to reach that, but if you muddle your
->can() func lookups or something it's at least conceivable.

Maybe the object/package/gtype lookup could guard against a non-ref, at
least to the point of not segfaulting.  The couple of lines below gets
that effect, collecting up common bits of four overloads.

Index: GType.xs
===================================================================
--- GType.xs    (revision 1062)
+++ GType.xs    (working copy)
@@ -1,5 +1,5 @@
 /*
- * Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for
+ * Copyright (C) 2003-2005, 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
@@ -228,6 +228,21 @@
        return res;
 }
 
+/* objref should be a reference to a blessed something; the return is
+   G_TYPE_NONE if it's any other SV.  Is it worth making this public?  Leave
+   it private for now.  */
+static GType
+gperl_fundamental_type_from_obj (SV *objref)
+{
+        SV *obj;
+        const char *package;
+        obj = SvRV(objref);
+        if (obj == NULL)
+                return G_TYPE_NONE;  /* ref is not a reference */
+       package = sv_reftype (obj, TRUE);
+       return gperl_fundamental_type_from_package (package);
+}
+
 =item const char * gperl_fundamental_package_from_type (GType gtype)
 
 look up the package corresponding to a I<gtype> registered by
@@ -2767,9 +2782,7 @@
     PROTOTYPE: $;@
     CODE:
         RETVAL = !!gperl_convert_flags (
-                     gperl_fundamental_type_from_package (
-                       sv_reftype (SvRV (a), TRUE)
-                     ),
+                     gperl_fundamental_type_from_obj (a),
                      a
                    );
     OUTPUT:
@@ -2789,11 +2802,9 @@
         * users call method-style with no args "$f->as_arrayref" too.
         */
        GType gtype;
-       const char *package;
         gint a_;
 
-       package = sv_reftype (SvRV (a), TRUE);
-       gtype = gperl_fundamental_type_from_package (package);
+       gtype = gperl_fundamental_type_from_obj (a);
         a_ = gperl_convert_flags (gtype, a);
 
         RETVAL = flags_as_arrayref (gtype, a_);
@@ -2813,8 +2824,7 @@
        const char *package;
         gint a_, b_;
 
-       package = sv_reftype (SvRV (a), TRUE);
-       gtype = gperl_fundamental_type_from_package (package);
+       gtype = gperl_fundamental_type_from_obj (a);
         a_ = gperl_convert_flags (gtype, swap ? b : a);
         b_ = gperl_convert_flags (gtype, swap ? a : b);
 
@@ -2838,11 +2848,9 @@
     CODE:
 {
        GType gtype;
-       const char *package;
         gint a_, b_;
 
-       package = sv_reftype (SvRV (a), TRUE);
-       gtype = gperl_fundamental_type_from_package (package);
+       gtype = gperl_fundamental_type_from_obj (a);
         a_ = gperl_convert_flags (gtype, SvTRUE (swap) ? b : a);
         b_ = gperl_convert_flags (gtype, SvTRUE (swap) ? a : b);
 
Index: t/c.t
===================================================================
--- t/c.t       (revision 1062)
+++ t/c.t       (working copy)
@@ -13,7 +13,7 @@
 
 #########################
 
-use Test::More tests => 35;
+use Test::More tests => 51;
 BEGIN { use_ok('Glib') };
 
 #########################
@@ -50,6 +50,14 @@
       "overloaded += leaves original unchanged");
 }
 
+foreach my $method (qw(bool as_arrayref eq union sub intersect xor all)) {
+  my $func = Glib::Flags->can($method);
+  ok ($func, "Glib::Flags::$method() func found");
+  no warnings;
+  ok (do { eval { $func->(undef, undef, 0) }; 1 },
+      'Glib::Flags::$method() no segfault if passed a non-reference');
+}
+
 #########################
 
 $@ = undef;
@@ -241,7 +249,7 @@
 
 __END__
 
-Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the
+Copyright (C) 2003-2005, 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