[perl-Glib-Object-Introspection] Implement a generic constructor for boxed types

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

commit fc2a3ceb6d07bd0e2010dcb3cc0473e9fe4464c0
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sat Aug 18 00:37:52 2012 +0200

    Implement a generic constructor for boxed types
    
    Install it as Glib::Object::new to make it available for all boxed types, even
    those which already have a constructor.

 GObjectIntrospection.xs          |   37 +++++++++++++++++++++++++++++++++++++
 NEWS                             |    4 +++-
 lib/Glib/Object/Introspection.pm |   19 +++++++++++++++++++
 t/boxed.t                        |   18 +++++++++++++++++-
 4 files changed, 76 insertions(+), 2 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index e030f49..20e6236 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -545,6 +545,43 @@ _fetch_constant (class, basename, constant)
 	RETVAL
 
 SV *
+_construct_boxed (class, package)
+	const gchar *package
+    PREINIT:
+	GIRepository *repository;
+	GType gtype;
+	GIBaseInfo *info;
+	gsize size;
+	gpointer tmp_mem;
+    CODE:
+	gtype = gperl_boxed_type_from_package (package);
+	if (!gtype)
+		croak ("Could not find GType for package %s", package);
+	repository = g_irepository_get_default ();
+	info = g_irepository_find_by_gtype (repository, gtype);
+	if (!info) {
+		g_base_info_unref (info);
+		croak ("Could not fetch information for package %s; "
+		       "perhaps it has not been loaded via "
+		       "Glib::Object::Introspection?",
+		       package);
+	}
+	size = g_struct_info_get_size (info);
+	/* We allocate memory for the boxed type here with malloc(), but then
+	 * take a copy of it and discard the original so that the memory we
+	 * hand out is always allocated with the allocator used for the boxed
+	 * type.  Maybe we should use g_alloca? */
+	tmp_mem = g_malloc0 (size);
+	/* No PUTBACK/SPAGAIN needed here since the code that xsubpp generates
+	 * for OUTPUT does not refer to our local copy of the stack pointer
+	 * (but uses the ST macro). */
+	RETVAL = gperl_new_boxed_copy (tmp_mem, gtype);
+	g_free (tmp_mem);
+	g_base_info_unref (info);
+    OUTPUT:
+	RETVAL
+
+SV *
 _get_field (class, basename, namespace, field, invocant)
 	const gchar *basename
 	const gchar *namespace
diff --git a/NEWS b/NEWS
index 9c83333..5178025 100644
--- a/NEWS
+++ b/NEWS
@@ -2,7 +2,9 @@ Overview of changes in Glib::Object::Introspection <next>
 ========================================================
 
 * Implement generic signal marshalling.
-* Generate error messages when function are passed an incorrect number of
+* Implement a generic constructor for boxed types and install it as
+  Glib::Boxed::new.
+* Generate error messages when functions are passed an incorrect number of
   parameters.
 * Avoid using vfunc names that coincide with special Perl subs.  This fixes
   double-frees occurring for subclasses of Gtk3::Widget.
diff --git a/lib/Glib/Object/Introspection.pm b/lib/Glib/Object/Introspection.pm
index 731e7fd..ce7c1b5 100644
--- a/lib/Glib/Object/Introspection.pm
+++ b/lib/Glib/Object/Introspection.pm
@@ -154,6 +154,25 @@ sub setup {
     }
   }
 
+  # Monkey-patch Glib with a generic constructor for boxed types.  Glib cannot
+  # provide this on its own because it does not know how big the struct of a
+  # boxed type is.  FIXME: This sort of violates encapsulation.
+  {
+    if (! defined &{Glib::Boxed::new}) {
+      *{Glib::Boxed::new} = sub {
+        my ($class, @rest) = @_;
+        my $boxed = Glib::Object::Introspection->_construct_boxed ($class);
+        my $fields = 1 == @rest ? $rest[0] : { @rest };
+        foreach my $field (keys %$fields) {
+          if ($boxed->can ($field)) {
+            $boxed->$field ($fields->{$field});
+          }
+        }
+        return $boxed;
+      }
+    }
+  }
+
   foreach my $name (@{$interfaces}) {
     my $adder_name = $package . '::' . $name . '::_ADD_INTERFACE';
     *{$adder_name} = sub {
diff --git a/t/boxed.t b/t/boxed.t
index 11b66d2..0b8bf51 100644
--- a/t/boxed.t
+++ b/t/boxed.t
@@ -6,8 +6,9 @@ use strict;
 use warnings;
 use Scalar::Util qw/weaken/;
 
-plan tests => 41;
+plan tests => 47;
 
+# Use the provided constructor.
 {
   my $boxed = GI::BoxedStruct->new;
   isa_ok ($boxed, 'GI::BoxedStruct');
@@ -19,6 +20,21 @@ plan tests => 41;
   is ($boxed, undef);
 }
 
+# Use our generic constructor.
+{
+  my $boxed = Glib::Boxed::new ('GI::BoxedStruct', {long_ => 42});
+  isa_ok ($boxed, 'GI::BoxedStruct');
+  is ($boxed->long_, 42);
+  is ($boxed->g_strv, undef);
+  $boxed->inv;
+
+  $boxed = Glib::Boxed::new ('GI::BoxedStruct', long_ => 42);
+  isa_ok ($boxed, 'GI::BoxedStruct');
+  is ($boxed->long_, 42);
+  is ($boxed->g_strv, undef);
+  $boxed->inv;
+}
+
 SKIP: {
   skip 'new stuff', 6
     unless check_gi_version (0, 12, 0);