[Jifty-commit] r5735 - in B-Generate/trunk: . lib/B
Jifty commits
jifty-commit at lists.jifty.org
Sat Aug 16 11:50:13 EDT 2008
Author: clkao
Date: Sat Aug 16 11:50:13 2008
New Revision: 5735
Added:
B-Generate/trunk/t/new_cv.t
Modified:
B-Generate/trunk/MANIFEST
B-Generate/trunk/lib/B/Generate.xs
Log:
B::CV NEW_with_start.
Modified: B-Generate/trunk/MANIFEST
==============================================================================
--- B-Generate/trunk/MANIFEST (original)
+++ B-Generate/trunk/MANIFEST Sat Aug 16 11:50:13 2008
@@ -11,6 +11,7 @@
BTest.pm
t/inspect-btest.t
t/inspect-this.t
+t/new_cv.t
t/op_list.t
t/op_list_bgen.t
typemap
Modified: B-Generate/trunk/lib/B/Generate.xs
==============================================================================
--- B-Generate/trunk/lib/B/Generate.xs (original)
+++ B-Generate/trunk/lib/B/Generate.xs Sat Aug 16 11:50:13 2008
@@ -1522,8 +1522,28 @@
RETVAL = mycv;
OUTPUT:
RETVAL
+
+#define PERL_CORE
+#include "embed.h"
-
+B::CV
+CV_NEW_with_start(cv, root, start)
+ B::CV cv
+ B::OP root
+ B::OP start
+ PREINIT:
+ CV *new;
+ CODE:
+ new = cv_clone(cv);
+ CvROOT(new) = root;
+ CvSTART(new) = start;
+ CvDEPTH(new) = 0;
+ SvREFCNT_inc(new);
+ RETVAL = new;
+ OUTPUT:
+ RETVAL
+
+#undef PERL_CORE
MODULE = B::Generate PACKAGE = B::PV PREFIX = Sv
Added: B-Generate/trunk/t/new_cv.t
==============================================================================
--- (empty file)
+++ B-Generate/trunk/t/new_cv.t Sat Aug 16 11:50:13 2008
@@ -0,0 +1,79 @@
+#!perl -w
+use strict;
+use Test::More tests => 23;
+use B::Generate;
+use strict;
+no warnings 'void';
+
+my $orz;
+
+sub foo {
+ my $n = shift;
+ return $orz->($n);
+}
+
+my ($a, $b) = 0;
+
+sub dothat_and_1 {
+ $a;
+ 1;
+}
+
+sub dothat_and_2 {
+ $b, $a;
+ 1;
+}
+
+sub inc_a {
+ ++$a;
+}
+
+
+
+sub prepend_function_with_inc {
+ my $code = shift;
+
+ my $whoami = B::svref_2object($code);
+ isa_ok($whoami, 'B::CV');
+ is($whoami->ROOT->name, 'leavesub');
+ is($whoami->START->name, 'nextstate');
+ my $leavesub = B::UNOP->new("leavesub", $whoami->ROOT->flags, $whoami->ROOT->first);
+ is($leavesub->name, 'leavesub');
+
+ my $inc_a = B::svref_2object(\&inc_a);
+ my $inc_a_entry = $inc_a->START;
+ is($inc_a_entry->name, 'nextstate');
+ my $padsv = $inc_a->START->next;
+
+ my $inc = $padsv->next;
+ is($inc->name, 'preinc');
+
+ my $nextstate = $whoami->START;
+ is($nextstate->name, 'nextstate');
+
+ $inc->sibling($nextstate);
+ $inc->next($nextstate);
+
+ my $orz_obj = $whoami->NEW_with_start($leavesub, $inc_a_entry);
+# my $orz_obj;
+ return $orz_obj->object_2svref;
+}
+
+$orz = prepend_function_with_inc(\&dothat_and_1);
+
+is(dothat_and_1(), 1);
+is($a, 0);
+is($orz->(), 1);
+is($a, 1);
+
+is($orz->(), 1);
+is($a, 2);
+
+$orz = prepend_function_with_inc(\&dothat_and_2);
+is($orz->(), 1);
+
+TODO: {
+local $TODO = 'need to fix svop padlist idx';
+is($a, 3);
+is($b, 0);
+}
More information about the Jifty-commit
mailing list