[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