[perl-Glib] Add Glib::Param->get_default_value()

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

commit e0ca2b7452e0ba2a9a0ea649f076fcb85ec9c72f
Author: Kevin Ryde <user42 zip com au>
Date:   Sun Nov 14 10:02:31 2010 +1100

    Add Glib::Param->get_default_value()
    
    Implemented via calling the generic g_param_value_set_default().  Gives
    $pspec->get_default_value() for Glib::Param::Override and Glib::Param::GType.
    
    https://bugzilla.gnome.org/show_bug.cgi?id=634349

 GParamSpec.xs |   88 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 t/e.t         |   87 +++++++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 171 insertions(+), 4 deletions(-)
---
diff --git a/GParamSpec.xs b/GParamSpec.xs
index 4d62460..1c8f536 100644
--- a/GParamSpec.xs
+++ b/GParamSpec.xs
@@ -674,6 +674,94 @@ get_value_type (GParamSpec * pspec)
 MODULE = Glib::ParamSpec	PACKAGE = Glib::ParamSpec	PREFIX = g_param_
 
 =for apidoc
+(This is the C level C<g_param_value_set_default> function.)
+
+Note that on a C<Glib::Param::Unichar> the return is a single-char
+string.  This is the same as the constructor
+C<< Glib::ParamSpec->unichar >>, but it's not the same as
+C<Glib::Object> C<< get_property >> / C<< set_property >>, so an
+C<ord()> conversion is needed if passing the default value to a
+unichar C<set_property>.
+=cut
+SV *
+get_default_value (GParamSpec * pspec)
+    PREINIT:
+	GValue v = { 0, };
+	GType type;
+    CODE:
+	/* crib note: G_PARAM_SPEC_VALUE_TYPE() is suitable for
+	   GParamSpecOverride and gives the target's value type */
+	type = G_PARAM_SPEC_VALUE_TYPE (pspec);
+	g_value_init (&v, type);
+	g_param_value_set_default (pspec, &v);
+
+	if (type == G_TYPE_BOOLEAN) {
+	  /* For historical compatibility with what Perl-Gtk2 has done in
+             the past, return boolSV() style '' or 1 for a G_TYPE_BOOLEAN,
+             the same as gboolean typemap output, not the newSViv() style 0
+             or 1 which the generic gperl_sv_from_value() would give on
+             G_TYPE_BOOLEAN.
+
+             The two falses, '' vs 0, are of course the same in any boolean
+             context or arithmetic, but maybe someone has done a string
+             compare or something, so keep ''.
+
+             This applies to Glib::Param::Boolean and in the interests of
+             consistency also to a Glib::Param::Override targetting a
+             boolean, and also to any hypothetical other ParamSpec which had
+             value type G_TYPE_BOOLEAN, either a sub-type of
+             GParamSpecBoolean or just a completely separate one with
+             G_TYPE_BOOLEAN.  */
+
+	  RETVAL = boolSV (g_value_get_boolean (&v));
+
+        } else if (type == G_TYPE_UINT) {
+	  /* For historical compatibility with what Perl-Gtk2 has done in
+	     the past, return a single-char string for GParamSpecUnichar.
+	     The GValue for a GParamSpecUnichar is only a G_TYPE_UINT and
+	     gperl_sv_from_value() would give an integer.
+
+	     This applies to Glib::Param::Unichar and in the interests of
+	     consistency is applied also to a Glib::Param::Override
+	     targetting a unichar, and also to any sub-type of
+	     GParamUnichar.
+
+	     As noted in the POD above this is a bit unfortunate, since it
+	     means $obj->set_property() can't be simply called with
+	     $obj->find_property->get_default_value().  Watch this space for
+	     some sort of variation on get_default_value() which can go
+	     straight to set_property(), or to values_cmp() against a
+	     get_property(), etc. */
+
+	  GParamSpec *ptarget;
+#if GLIB_CHECK_VERSION(2, 4, 0)
+	  ptarget = g_param_spec_get_redirect_target(pspec);
+	  if (! ptarget) { ptarget = pspec; }
+#else
+	  ptarget = pspec;
+#endif
+	  if (g_type_is_a (G_PARAM_SPEC_TYPE(ptarget), G_TYPE_PARAM_UNICHAR)) {
+	    {
+	      gchar temp[6];
+	      gint length = g_unichar_to_utf8 (g_value_get_uint(&v), temp);
+	      RETVAL = newSVpv (temp, length);
+	      SvUTF8_on (RETVAL);
+	    }
+	  } else {
+	    /* a plain uint, not a unichar */
+	    goto plain_gvalue;
+	  }
+
+	} else {
+	plain_gvalue:
+	  RETVAL = gperl_sv_from_value (&v);
+	}
+	g_value_unset (&v);
+    OUTPUT:
+	RETVAL
+
+
+=for apidoc
 =signature bool = $paramspec->value_validate ($value)
 =signature (bool, newval) = $paramspec->value_validate ($value)
 In scalar context return true if $value must be modified to be valid
diff --git a/t/e.t b/t/e.t
index 030e590..4892b91 100644
--- a/t/e.t
+++ b/t/e.t
@@ -5,7 +5,7 @@
 use strict;
 use utf8;
 use Glib ':constants';
-use Test::More tests => 278;
+use Test::More tests => 305;
 
 # first register some types with which to play below.
 
@@ -61,8 +61,14 @@ $pspec = Glib::ParamSpec->boolean ('boolean', 'Boolean',
 	                           TRUE, 'readable');
 pspec_common_ok ($pspec, 'Boolean', 'readable');
 ok ($pspec->get_default_value, "Boolean default (expect TRUE)");
-
 push @params, $pspec;
+{
+  $pspec = Glib::ParamSpec->boolean ('boolean-default-false',
+				     'Boolean-default-false',
+				     'Blurb',
+				     FALSE, 'readable');
+  is ($pspec->get_default_value, '');  # boolSV style empty '' return
+}
 
 
 $pspec = Glib::ParamSpec->string ('string', 'String',
@@ -174,6 +180,21 @@ $pspec = Glib::ParamSpec->unichar ('unichar', 'Unichar',
 pspec_common_ok ($pspec, 'Unichar', qw/readable/, 'Glib::UInt');
 is ($pspec->get_default_value, 'ö', 'Unichar default');
 push @params, $pspec;
+{
+  $pspec = Glib::ParamSpec->unichar ('unichar-nul', 'Unichar-Nul',
+				     'Blurb',
+				     "\0", # default
+				     qw/readable/);
+  is ($pspec->get_default_value, "\0",
+      'ParamSpec unichar - default zero byte');
+
+  $pspec = Glib::ParamSpec->unichar ('unichar-nul', 'Unichar-Nul',
+				     'Blurb',
+				     "0", # default
+				     qw/readable/);
+  is ($pspec->get_default_value, "0",
+      'ParamSpec unichar - default zero digit');
+}
 
 
 #
@@ -218,7 +239,7 @@ foreach (@params) {
 
 
 SKIP: {
-	skip "GParamSpecOverride is new in glib 2.4.0", 3
+	skip "GParamSpecOverride is new in glib 2.4.0", 27
 		unless Glib->CHECK_VERSION (2, 4, 0);
 
 	my $pbase = Glib::ParamSpec->boolean ('obool','obool', 'Blurb',
@@ -228,6 +249,64 @@ SKIP: {
 	$pspec = Glib::ParamSpec->override ('over', $pbase);
 	isa_ok ($pspec, 'Glib::Param::Override');
 	is_deeply ($pspec->get_redirect_target, $pbase);
+	{
+	  my $pbase = Glib::ParamSpec->boolean ('obool',
+						'Obool',
+						'pbase blurb',
+						0, G_PARAM_READWRITE);
+	  is ($pbase->get_default_value, '');
+	  is ($pbase->get_redirect_target, undef);
+
+	  # p1 targetting pbase
+	  my $p1 = Glib::ParamSpec->override ('over', $pbase);
+	  isa_ok ($p1, 'Glib::Param::Override');
+	  # is_deeply() because paramspec is GBoxed, so no identical objects
+	  is_deeply ($p1->get_redirect_target, $pbase);
+
+	  is ($p1->get_blurb, 'pbase blurb');
+	  is ($p1->get_nick,  'Obool');
+	  is ($p1->get_default_value, '');
+
+	  # p2 targetting p1
+	  my $p2 = Glib::ParamSpec->override ('over-over', $p1);
+	  isa_ok ($p2, 'Glib::Param::Override');
+	  # is_deeply() because paramspec is GBoxed, so no identical objects
+	  is_deeply ($p2->get_redirect_target, $pbase);
+
+	  is ($p2->get_blurb, 'pbase blurb');
+	  is ($p2->get_nick,  'Obool');
+	  is ($p2->get_default_value, '');
+	}
+
+	{
+	  my $pbase = Glib::ParamSpec->unichar ('ounichar',
+						'Ounichar',
+						'pbase blurb',
+						'z',
+						G_PARAM_READWRITE);
+	  is ($pbase->get_default_value, 'z');
+	  is ($pbase->get_redirect_target, undef);
+
+	  # p1 targetting pbase
+	  my $p1 = Glib::ParamSpec->override ('over', $pbase);
+	  isa_ok ($p1, 'Glib::Param::Override');
+	  # is_deeply() because paramspec is GBoxed, so no identical objects
+	  is_deeply ($p1->get_redirect_target, $pbase);
+
+	  is ($p1->get_blurb, 'pbase blurb');
+	  is ($p1->get_nick,  'Ounichar');
+	  is ($p1->get_default_value, 'z');
+
+	  # p2 targetting p1
+	  my $p2 = Glib::ParamSpec->override ('over-over', $p1);
+	  isa_ok ($p2, 'Glib::Param::Override');
+	  # is_deeply() because paramspec is GBoxed, so no identical objects
+	  is_deeply ($p2->get_redirect_target, $pbase);
+
+	  is ($p2->get_blurb, 'pbase blurb');
+	  is ($p2->get_nick,  'Ounichar');
+	  is ($p2->get_default_value, 'z');
+	}
 }
 
 #
@@ -261,7 +340,7 @@ SKIP: {
 
 	my $baz = Glib::Object::new ('Baz');
 	isa_ok ($baz, 'Glib::Object');
-	is ($baz->get ('object'), undef);
+	is ($baz->get ('object'), 'Glib::Object');
 	is ($baz->get ('type'), undef);
 
 	$baz = Glib::Object::new ('Baz', object => 'Bar', type => 'Glib::ParamSpec');