perl-Glib r1074 - in trunk: . t

[tsch svn gnome org]

Author: tsch
Date: Thu Feb  5 14:14:54 2009
New Revision: 1074
URL: http://svn.gnome.org/viewvc/perl-Glib?rev=1074&view=rev

Log:
Make the various Glib::Flags methods more robust with respect to receiving
undefined input.  Patch by Kevin Ryde.


Modified:
   trunk/ChangeLog
   trunk/GType.xs
   trunk/t/c.t

Modified: trunk/GType.xs
==============================================================================
--- trunk/GType.xs	(original)
+++ trunk/GType.xs	Thu Feb  5 14:14:54 2009
@@ -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
@@ -232,6 +232,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
@@ -2771,9 +2786,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:
@@ -2793,11 +2806,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_);
@@ -2814,11 +2825,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, swap ? b : a);
         b_ = gperl_convert_flags (gtype, swap ? a : b);
 
@@ -2842,11 +2851,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);
 

Modified: trunk/t/c.t
==============================================================================
--- trunk/t/c.t	(original)
+++ trunk/t/c.t	Thu Feb  5 14:14:54 2009
@@ -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