[perl-Glib-Object-Introspection] Fix marshalling of out arguments in callbacks

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

commit e484dab9dc3a33c5fb1f090960c0ca75c4790cef
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Tue Oct 11 00:16:42 2011 +0200

    Fix marshalling of out arguments in callbacks

 gperl-i11n-invoke-perl.c |    8 ++++-
 t/vfunc-implementation.t |   80 ++++++++++++++++++++++++++++-----------------
 2 files changed, 57 insertions(+), 31 deletions(-)
---
diff --git a/gperl-i11n-invoke-perl.c b/gperl-i11n-invoke-perl.c
index 47b39f2..57de41c 100644
--- a/gperl-i11n-invoke-perl.c
+++ b/gperl-i11n-invoke-perl.c
@@ -144,6 +144,12 @@ invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata)
 			GIArgInfo *arg_info = g_callable_info_get_arg (cb_interface, i);
 			GITypeInfo *arg_type = g_arg_info_get_type (arg_info);
 			GIDirection direction = g_arg_info_get_direction (arg_info);
+			gpointer out_pointer = * (gpointer *) args[i];
+
+			if (!out_pointer) {
+				dwarn ("skipping out arg %d\n", i);
+				continue;
+			}
 
 			if (direction == GI_DIRECTION_INOUT ||
 			    direction == GI_DIRECTION_OUT)
@@ -154,7 +160,7 @@ invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata)
 				sv_to_arg (returned_values[out_index], &tmp_arg,
 				           arg_info, arg_type,
 				           transfer, may_be_null, NULL);
-				arg_to_raw (&tmp_arg, args[i], arg_type);
+				arg_to_raw (&tmp_arg, out_pointer, arg_type);
 				out_index++;
 			}
 		}
diff --git a/t/vfunc-implementation.t b/t/vfunc-implementation.t
index fc6b1d8..17618e7 100644
--- a/t/vfunc-implementation.t
+++ b/t/vfunc-implementation.t
@@ -5,45 +5,20 @@ BEGIN { require './t/inc/setup.pl' };
 use strict;
 use warnings;
 
-plan tests => 28;
+plan tests => 35;
 
 {
-  package NoImplementation;
-  use Glib::Object::Subclass 'GI::Object';
-}
-
-{
-  my $foo = NoImplementation->new;
-  local $@;
-  eval { $foo->method_int8_in (23) };
-  like ($@, qr/method_int8_in/);
-}
-
-{
-  package BadChaininig;
+  package GoodImplementation;
   use Glib::Object::Subclass 'GI::Object';
   sub METHOD_INT8_IN {
     my ($self, $int8) = @_;
     Test::More::isa_ok ($self, __PACKAGE__);
     Test::More::is ($int8, 23);
-    return $self->SUPER::METHOD_INT8_IN ($int8);
   }
-}
-
-{
-  my $foo = BadChaininig->new;
-  local $@;
-  eval { $foo->method_int8_in (23) };
-  like ($@, qr/method_int8_in/);
-}
-
-{
-  package GoodImplementation;
-  use Glib::Object::Subclass 'GI::Object';
-  sub METHOD_INT8_IN {
-    my ($self, $int8) = @_;
+  sub METHOD_INT8_OUT {
+    my ($self) = @_;
     Test::More::isa_ok ($self, __PACKAGE__);
-    Test::More::is ($int8, 23);
+    return 42;
   }
 }
 
@@ -51,6 +26,7 @@ plan tests => 28;
   my $foo = GoodImplementation->new;
   $foo->method_int8_in (23);
   pass;
+  is ($foo->method_int8_out, 42);
   $foo->method_with_default_implementation (23);
   is ($foo->get ('int'), 23);
 }
@@ -65,6 +41,13 @@ plan tests => 28;
     # cannot chain up since GI::Object does not provide a default
     # implementation
   }
+  sub METHOD_INT8_OUT {
+    my ($self) = @_;
+    Test::More::isa_ok ($self, __PACKAGE__);
+    # cannot chain up since GI::Object does not provide a default
+    # implementation
+    return 42;
+  }
   sub METHOD_WITH_DEFAULT_IMPLEMENTATION {
     my ($self, $int8) = @_;
     Test::More::isa_ok ($self, __PACKAGE__);
@@ -90,6 +73,7 @@ plan tests => 28;
   my $foo = PerlInheritance->new;
   $foo->method_int8_in (23);
   pass;
+  is ($foo->method_int8_out, 42);
   $foo->method_with_default_implementation (23);
   is ($foo->get ('int'), 23);
 }
@@ -103,6 +87,11 @@ plan tests => 28;
     Test::More::is ($int8, 23);
     return $self->SUPER::METHOD_INT8_IN ($int8);
   }
+  sub METHOD_INT8_OUT {
+    my ($self, $int8) = @_;
+    Test::More::isa_ok ($self, __PACKAGE__);
+    return $self->SUPER::METHOD_INT8_OUT ();
+  }
   sub METHOD_WITH_DEFAULT_IMPLEMENTATION {
     my ($self, $int8) = @_;
     Test::More::isa_ok ($self, __PACKAGE__);
@@ -115,6 +104,37 @@ plan tests => 28;
   my $foo = PerlInheritanceWithChaining->new;
   $foo->method_int8_in (23);
   pass;
+  is ($foo->method_int8_out, 42);
   $foo->method_with_default_implementation (23);
   is ($foo->get ('int'), 23);
 }
+
+{
+  package NoImplementation;
+  use Glib::Object::Subclass 'GI::Object';
+}
+
+{
+  my $foo = NoImplementation->new;
+  local $@;
+  eval { $foo->method_int8_in (23) };
+  like ($@, qr/method_int8_in/);
+}
+
+{
+  package BadChaininig;
+  use Glib::Object::Subclass 'GI::Object';
+  sub METHOD_INT8_IN {
+    my ($self, $int8) = @_;
+    Test::More::isa_ok ($self, __PACKAGE__);
+    Test::More::is ($int8, 23);
+    return $self->SUPER::METHOD_INT8_IN ($int8);
+  }
+}
+
+{
+  my $foo = BadChaininig->new;
+  local $@;
+  eval { $foo->method_int8_in (23) };
+  like ($@, qr/method_int8_in/);
+}