Upgrade to Devel::PPPort 3.16

8 files changed, 58 insertions, 18 deletions

diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes
index 25d701d624..86d85d1120 100644
--- a/ext/Devel/PPPort/Changes
+++ b/ext/Devel/PPPort/Changes
@@ -1,3 +1,8 @@
+3.16 - 2009-01-23
+
+    * fix DEFSV_set() for threaded 5.005 perls
+    * add G_METHOD support to call_sv()
+
 3.15 - 2009-01-18
 
     * added support for the following API
diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL
index 663ff9d52e..fb818eaa91 100644
--- a/ext/Devel/PPPort/PPPort_pm.PL
+++ b/ext/Devel/PPPort/PPPort_pm.PL
@@ -535,7 +535,7 @@ package Devel::PPPort;
 use strict;
 use vars qw($VERSION $data);
 
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.15 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 sub _init_data
 {
diff --git a/ext/Devel/PPPort/parts/inc/call b/ext/Devel/PPPort/parts/inc/call
index a93e55ba40..85159e22a8 100644
--- a/ext/Devel/PPPort/parts/inc/call
+++ b/ext/Devel/PPPort/parts/inc/call
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 18 $
+##  $Revision: 19 $
 ##  $Author: mhx $
-##  $Date: 2009/01/18 14:10:53 +0100 $
+##  $Date: 2009/01/23 18:27:48 +0100 $
 ##
 ################################################################################
 ##
@@ -25,6 +25,7 @@ call_argv
 call_method
 load_module
 vload_module
+G_METHOD
 
 =implementation
 
@@ -35,12 +36,25 @@ __UNDEFINED__  call_argv     perl_call_argv
 __UNDEFINED__  call_method   perl_call_method
 
 __UNDEFINED__  eval_sv       perl_eval_sv
+/* Replace: 0 */
 
 __UNDEFINED__ PERL_LOADMOD_DENY		0x1
 __UNDEFINED__ PERL_LOADMOD_NOIMPORT	0x2
 __UNDEFINED__ PERL_LOADMOD_IMPORT_OPS	0x4
 
-/* Replace: 0 */
+#ifndef G_METHOD
+# define G_METHOD		64
+# ifdef call_sv
+#  undef call_sv
+# endif
+# if { VERSION < 5.6.0 }
+#  define call_sv(sv, flags)  ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
+				(flags) & ~G_METHOD) : perl_call_sv(sv, flags))
+# else
+#  define call_sv(sv, flags)  ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
+				(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
+# endif
+#endif
 
 /* Replace perl_eval_pv with eval_pv */
 
@@ -266,6 +280,23 @@ call_method(methname, flags, ...)
 		mPUSHi(i);
 
 void
+call_sv_G_METHOD(sv, flags, ...)
+	SV* sv
+	I32 flags
+	PREINIT:
+		I32 i;
+	PPCODE:
+		for (i=0; i<items-2; i++)
+		  ST(i) = ST(i+2); /* pop first two args */
+		PUSHMARK(SP);
+		SP += items - 2;
+		PUTBACK;
+		i = call_sv(sv, flags | G_METHOD);
+		SPAGAIN;
+		EXTEND(SP, 1);
+		mPUSHi(i);
+
+void
 load_module(flags, name, version, ...)
 	U32 flags
 	SV *name
@@ -276,7 +307,7 @@ load_module(flags, name, version, ...)
 		Perl_load_module(aTHX_ flags, SvREFCNT_inc_simple(name),
 		                 SvREFCNT_inc_simple(version), NULL);
 
-=tests plan => 46
+=tests plan => 52
 
 sub eq_array
 {
@@ -325,6 +356,7 @@ for $test (
     ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected));
     ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected));
     ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected));
+    ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected));
 };
 
 ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
diff --git a/ext/Devel/PPPort/parts/inc/misc b/ext/Devel/PPPort/parts/inc/misc
index c1da3bfa0d..8044df92a1 100644
--- a/ext/Devel/PPPort/parts/inc/misc
+++ b/ext/Devel/PPPort/parts/inc/misc
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 50 $
+##  $Revision: 51 $
 ##  $Author: mhx $
-##  $Date: 2009/01/18 14:10:55 +0100 $
+##  $Date: 2009/01/23 18:28:31 +0100 $
 ##
 ################################################################################
 ##
@@ -162,7 +162,7 @@ __UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
 /* DEFSV appears first in 5.004_56 */
 __UNDEFINED__  DEFSV	    GvSV(PL_defgv)
 __UNDEFINED__  SAVE_DEFSV   SAVESPTR(GvSV(PL_defgv))
-__UNDEFINED__  DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
+__UNDEFINED__  DEFSV_set(sv) (DEFSV = (sv))
 
 /* Older perls (<=5.003) lack AvFILLp */
 __UNDEFINED__  AvFILLp      AvFILL
@@ -393,7 +393,9 @@ DEFSV_modify()
 		SAVE_DEFSV;
 		DEFSV_set(newSVpvs("DEFSV"));
 		XPUSHs(sv_mortalcopy(DEFSV));
-		sv_2mortal(DEFSV);
+		/* Yes, this leaks the above scalar; 5.005 with threads for some reason */
+		/* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
+		/* sv_2mortal(DEFSV); */
 		LEAVE;
 		XPUSHs(sv_mortalcopy(DEFSV));
 		XSRETURN(3);
diff --git a/ext/Devel/PPPort/parts/inc/ppphtest b/ext/Devel/PPPort/parts/inc/ppphtest
index 8162aa0049..f94cc7de2d 100644
--- a/ext/Devel/PPPort/parts/inc/ppphtest
+++ b/ext/Devel/PPPort/parts/inc/ppphtest
@@ -1,8 +1,8 @@
 ################################################################################
 ##
-##  $Revision: 45 $
+##  $Revision: 46 $
 ##  $Author: mhx $
-##  $Date: 2009/01/18 14:10:53 +0100 $
+##  $Date: 2009/01/23 18:28:00 +0100 $
 ##
 ################################################################################
 ##
@@ -682,8 +682,8 @@ for (@o) {
 ok(@o > 100);
 ok($fail, 0);
 
-ok(exists $p{call_sv});
-ok(not ref $p{call_sv});
+ok(exists $p{call_pv});
+ok(not ref $p{call_pv});
 
 ok(exists $p{grok_bin});
 ok(ref $p{grok_bin}, 'HASH');
diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak
index 02ee38c6fd..9a67665b9a 100644
--- a/ext/Devel/PPPort/soak
+++ b/ext/Devel/PPPort/soak
@@ -33,7 +33,7 @@ use File::Find;
 use List::Util qw(max);
 use Config;
 
-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.15 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 $| = 1;
 my %OPT = (
diff --git a/ext/Devel/PPPort/t/call.t b/ext/Devel/PPPort/t/call.t
index 6a5da7079a..ffa43ca788 100644
--- a/ext/Devel/PPPort/t/call.t
+++ b/ext/Devel/PPPort/t/call.t
@@ -30,9 +30,9 @@ BEGIN {
     require 'testutil.pl' if $@;
   }
 
-  if (46) {
+  if (52) {
     load();
-    plan(tests => 46);
+    plan(tests => 52);
   }
 }
 
@@ -95,6 +95,7 @@ for $test (
     ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected));
     ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected));
     ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected));
+    ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected));
 };
 
 ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
diff --git a/ext/Devel/PPPort/t/ppphtest.t b/ext/Devel/PPPort/t/ppphtest.t
index 36dcc0ccea..19fad35316 100644
--- a/ext/Devel/PPPort/t/ppphtest.t
+++ b/ext/Devel/PPPort/t/ppphtest.t
@@ -713,8 +713,8 @@ for (@o) {
 ok(@o > 100);
 ok($fail, 0);
 
-ok(exists $p{call_sv});
-ok(not ref $p{call_sv});
+ok(exists $p{call_pv});
+ok(not ref $p{call_pv});
 
 ok(exists $p{grok_bin});
 ok(ref $p{grok_bin}, 'HASH');