[Bast-commits] r4921 - trunk/Devel-BeginLift

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2008-10-16 11:40:54 +0100 (Thu, 16 Oct 2008)
New Revision: 4921

Added:
   trunk/Devel-BeginLift/generate.diff
   trunk/Devel-BeginLift/nuffin.diff
Log:
commit diffs for review

Added: trunk/Devel-BeginLift/generate.diff
===================================================================
--- trunk/Devel-BeginLift/generate.diff	                        (rev 0)
+++ trunk/Devel-BeginLift/generate.diff	2008-10-16 10:40:54 UTC (rev 4921)
@@ -0,0 +1,52 @@
+=== t/generate.t
+==================================================================
+--- t/generate.t	(revision 24729)
++++ t/generate.t	(local)
+@@ -2,43 +2,18 @@
+ use warnings;
+ use Test::More;
+ 
+-use B::Utils;
+-
+ BEGIN {
+     plan skip_all => "B::Generate required" unless eval { require B::Generate };
+     plan 'no_plan';
+ }
+ 
+-sub foo {
+-    B::SVOP->new("const", 0, 42);
++sub foo { 
++    return B::SVOP->new("const", 0, 42);
+ }
+ 
+-sub gorch ($) {
+-    my $meth = ( $_[0]->kids )[-1]->sv->object_2svref;
+-    $$meth = "other";
+-    $_[0];
+-}
++use Devel::BeginLift qw(foo);
+ 
+-use Devel::BeginLift qw(foo gorch);
+-
+ sub bar { 7 + foo() }
++
+ is( bar(), 49, "optree injected" );
+ 
+-sub blah { foo(31) }
+-is(blah(), 42, "optree injected" );;
+-
+-sub meth { 3 }
+-
+-sub other { 42 }
+-
+-__END__
+-
+-my $obj = bless {};
+-sub oink { gorch $obj->meth; }
+-
+-is( oink(), 42, "modify method call");
+-
+-my @args = ( 1 .. 3 );
+-sub ploink { gorch $obj->meth(1, @args); }
+-is( ploink(), 42, "modify method call with args");
+-

Added: trunk/Devel-BeginLift/nuffin.diff
===================================================================
--- trunk/Devel-BeginLift/nuffin.diff	                        (rev 0)
+++ trunk/Devel-BeginLift/nuffin.diff	2008-10-16 10:40:54 UTC (rev 4921)
@@ -0,0 +1,41 @@
+=== lib/Devel/BeginLift.xs
+==================================================================
+--- lib/Devel/BeginLift.xs	(revision 80093)
++++ lib/Devel/BeginLift.xs	(local)
+@@ -88,6 +88,12 @@
+     op_free(o);
+     if (type == OP_RV2GV)
+       return newGVOP(OP_GV, 0, (GV*)sv);
++
++    if (SvROK(sv) && sv_derived_from(sv, "B::OP")) {
++        /* taken from B's typemap file, T_OP_OBJ */
++        return INT2PTR(OP *,SvIV((SV *)SvRV(sv)));
++    }
++
+     return newSVOP(OP_CONST, 0, sv);
+   } else {
+     /* this bit not lifted, handles the 'sub doesn't return stuff' case
+=== t/generate.t
+==================================================================
+--- t/generate.t	(revision 80093)
++++ t/generate.t	(local)
+@@ -0,0 +1,19 @@
++use strict;
++use warnings;
++use Test::More;
++
++BEGIN {
++    plan skip_all => "B::Generate required" unless eval { require B::Generate };
++    plan 'no_plan';
++}
++
++sub foo { 
++    return B::SVOP->new("const", 0, 42);
++}
++
++use Devel::BeginLift qw(foo);
++
++sub bar { 7 + foo() }
++
++is( bar(), 49, "optree injected" );
++