[perl-Glib] Correctly check whether an SV is a reference

[Torsten SchÃnfeld <tsch src gnome org>]

commit 3c6c33f1d24e7936dfc4ca183e97e2bd35d3fd6d
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Tue Aug 2 23:47:23 2011 +0200

    Correctly check whether an SV is a reference
    
    Introduce the macro gperl_sv_is_ref and use it in favor of bare SvROK.
    The former calls gperl_sv_is_defined and thus invokes "get magic" before
    using SvROK.  This ensures that "magic" things (like tied variables) are
    handled correctly.

 GBookmarkFile.xs |    2 +-
 GBoxed.xs        |    6 +++---
 GKeyFile.xs      |    2 +-
 GObject.xs       |    8 +++-----
 GOption.xs       |    2 +-
 GParamSpec.xs    |    2 +-
 GSignal.xs       |    3 +--
 GType.xs         |    2 +-
 MANIFEST         |    1 +
 gperl.h          |    8 +++++---
 t/tied_flags.t   |   17 +++++++++++++++++
 typemap          |    2 +-
 12 files changed, 36 insertions(+), 19 deletions(-)
---
diff --git a/GBookmarkFile.xs b/GBookmarkFile.xs
index 7d93c17..0d67068 100644
--- a/GBookmarkFile.xs
+++ b/GBookmarkFile.xs
@@ -43,7 +43,7 @@ GBookmarkFile *
 SvGBookmarkFile (SV * sv)
 {
 	MAGIC * mg;
-	if (!sv || !SvROK (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
+	if (!gperl_sv_is_ref (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
 		return NULL;
 	return (GBookmarkFile *) mg->mg_ptr;
 }
diff --git a/GBoxed.xs b/GBoxed.xs
index a192b9a..aabda0f 100644
--- a/GBoxed.xs
+++ b/GBoxed.xs
@@ -379,7 +379,7 @@ default_boxed_unwrap (GType        gtype,
 
 	PERL_UNUSED_VAR (gtype);
 
-	if (!SvROK (sv))
+	if (!gperl_sv_is_ref (sv))
 		croak ("expected a blessed reference");
 
 	if (!sv_derived_from (sv, package))
@@ -611,7 +611,7 @@ strv_unwrap (GType        gtype,
 	if (!gperl_sv_is_defined (sv))
 		return NULL;
 
-	if (SvROK (sv)) {
+	if (gperl_sv_is_ref (sv)) {
 		AV * av;
 		int n;
 
@@ -726,7 +726,7 @@ DESTROY (sv)
 	const char * class;
 	GPerlBoxedDestroyFunc destroy;
     CODE:
-	if (!gperl_sv_is_defined (sv) || !SvROK (sv) || !SvRV (sv))
+	if (!gperl_sv_is_ref (sv) || !SvRV (sv))
 		croak ("DESTROY called on a bad value");
 
 	/* we need to find the wrapper class associated with whatever type
diff --git a/GKeyFile.xs b/GKeyFile.xs
index 2892607..26a41d4 100644
--- a/GKeyFile.xs
+++ b/GKeyFile.xs
@@ -80,7 +80,7 @@ GKeyFile *
 SvGKeyFile (SV * sv)
 {
 	MAGIC * mg;
-	if (!sv || !SvROK (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
+	if (!gperl_sv_is_ref (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
 		return NULL;
 	return (GKeyFile *) mg->mg_ptr;
 }
diff --git a/GObject.xs b/GObject.xs
index afccc4b..b5492e4 100644
--- a/GObject.xs
+++ b/GObject.xs
@@ -960,8 +960,7 @@ gperl_get_object (SV * sv)
 {
 	MAGIC *mg;
 
-	if (!gperl_sv_is_defined (sv) || !SvROK (sv)
-	    || !(mg = _gperl_find_mg (SvRV (sv))))
+	if (!gperl_sv_is_ref (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
 		return NULL;
 
 	return (GObject *) mg->mg_ptr;
@@ -986,7 +985,7 @@ gperl_get_object_check (SV * sv,
 	if (!package)
 		croak ("INTERNAL: GType %s (%d) is not registered with GPerl!",
 		       g_type_name (gtype), gtype);
-	if (!sv || !SvROK (sv) || !sv_derived_from (sv, package))
+	if (!gperl_sv_is_ref (sv) || !sv_derived_from (sv, package))
 		croak ("%s is not of type %s",
 		       gperl_format_variable_for_output (sv),
 		       package);
@@ -1501,8 +1500,7 @@ g_object_find_property (object_or_class_name, ...)
 	GType type = G_TYPE_INVALID;
 	gchar *name = NULL;
     PPCODE:
-	if (gperl_sv_is_defined (object_or_class_name) &&
-	    SvROK (object_or_class_name)) {
+	if (gperl_sv_is_ref (object_or_class_name)) {
 		GObject * object = SvGObject (object_or_class_name);
 		if (!object)
 			croak ("wha?  NULL object in list_properties");
diff --git a/GOption.xs b/GOption.xs
index 1eb9dd8..c20cbb4 100644
--- a/GOption.xs
+++ b/GOption.xs
@@ -223,7 +223,7 @@ gperl_arg_info_table_destroy (GPerlArgInfoTable *table)
 static void
 handle_arg_data (GOptionEntry *entry, SV *ref, GHashTable *scalar_to_info)
 {
-	if (!SvROK (ref))
+	if (!gperl_sv_is_ref (ref))
 		croak ("encountered non-reference variable for the arg_value "
 		       "field");
 
diff --git a/GParamSpec.xs b/GParamSpec.xs
index 6c2e046..fb9fefb 100644
--- a/GParamSpec.xs
+++ b/GParamSpec.xs
@@ -203,7 +203,7 @@ GParamSpec *
 SvGParamSpec (SV * sv)
 {
 	MAGIC * mg;
-	if (!sv || !SvROK (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
+	if (!gperl_sv_is_ref (sv) || !(mg = _gperl_find_mg (SvRV (sv))))
 		return NULL;
 	return (GParamSpec*) mg->mg_ptr;
 }
diff --git a/GSignal.xs b/GSignal.xs
index b71fe98..5bdfffd 100644
--- a/GSignal.xs
+++ b/GSignal.xs
@@ -436,8 +436,7 @@ get_gtype_or_croak (SV * object_or_class_name)
 {
 	GType gtype;
 
-	if (gperl_sv_is_defined (object_or_class_name) &&
-	    SvROK (object_or_class_name)) {
+	if (gperl_sv_is_ref (object_or_class_name)) {
 		GObject * object = SvGObject (object_or_class_name);
 		if (!object)
 			croak ("bad object in signal_query");
diff --git a/GType.xs b/GType.xs
index e4b0d25..cc2e6de 100644
--- a/GType.xs
+++ b/GType.xs
@@ -483,7 +483,7 @@ gint
 gperl_convert_flags (GType type,
 		     SV * val)
 {
-	if (SvROK (val) && sv_derived_from (val, "Glib::Flags"))
+	if (gperl_sv_is_ref (val) && sv_derived_from (val, "Glib::Flags"))
 		return SvIV (SvRV (val));
 	if (gperl_sv_is_array_ref (val)) {
 		AV* vals = (AV*) SvRV(val);
diff --git a/MANIFEST b/MANIFEST
index 75cef7d..a91bd9d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -66,6 +66,7 @@ t/signal_emission_hooks.t
 t/signal_marshal.t
 t/signal_query.t
 t/tied_definedness.t
+t/tied_flags.t
 t/tied_set_property.t
 TODO
 typemap
diff --git a/gperl.h b/gperl.h
index 5737a49..01e48ac 100644
--- a/gperl.h
+++ b/gperl.h
@@ -412,12 +412,14 @@ char * gperl_format_variable_for_output (SV * sv);
 
 gboolean gperl_sv_is_defined (SV *sv);
 
+#define gperl_sv_is_ref(sv) \
+	(gperl_sv_is_defined (sv) && SvROK (sv))
 #define gperl_sv_is_array_ref(sv) \
-	(gperl_sv_is_defined (sv) && SvROK (sv) && SvTYPE (SvRV(sv)) == SVt_PVAV)
+	(gperl_sv_is_ref (sv) && SvTYPE (SvRV(sv)) == SVt_PVAV)
 #define gperl_sv_is_code_ref(sv) \
-	(gperl_sv_is_defined (sv) && SvROK (sv) && SvTYPE (SvRV(sv)) == SVt_PVCV)
+	(gperl_sv_is_ref (sv) && SvTYPE (SvRV(sv)) == SVt_PVCV)
 #define gperl_sv_is_hash_ref(sv) \
-	(gperl_sv_is_defined (sv) && SvROK (sv) && SvTYPE (SvRV(sv)) == SVt_PVHV)
+	(gperl_sv_is_ref (sv) && SvTYPE (SvRV(sv)) == SVt_PVHV)
 
 void gperl_hv_take_sv (HV *hv, const char *key, size_t key_length, SV *sv);
 
diff --git a/t/tied_flags.t b/t/tied_flags.t
new file mode 100644
index 0000000..88d69de
--- /dev/null
+++ b/t/tied_flags.t
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Glib;
+use Tie::Hash;
+use Test::More tests => 1;
+
+tie my %hash, 'Tie::StdHash';
+
+my $pspec = Glib::ParamSpec->boxed('t', 't', 't',
+                                   'Glib::Scalar', [qw/writable readable/]);
+$hash{flags} = $pspec->get_flags;
+ok (eval {
+      Glib::ParamSpec->boxed('t', 't', 't',
+                             'Glib::Scalar', $hash{flags});
+      1
+    });
diff --git a/typemap b/typemap
index d2e17a4..01bdd23 100644
--- a/typemap
+++ b/typemap
@@ -150,7 +150,7 @@ T_G_TYPE_IO_CONDITION
 	$var = gperl_convert_flags (G_TYPE_IO_CONDITION, $arg);
 
 T_G_MAIN_CONTEXT
-	if (!gperl_sv_is_defined ($arg) || !SvROK ($arg)) {
+	if (!gperl_sv_is_ref ($arg)) {
 		$var = NULL;
 	} else {
 		$var = INT2PTR ($type, SvIV (SvRV ($arg)));