[Jifty-commit] r5733 - in B-Generate/trunk: . lib/B

Jifty commits jifty-commit at lists.jifty.org
Sat Aug 16 11:31:11 EDT 2008


Author: clkao
Date: Sat Aug 16 11:31:11 2008
New Revision: 5733

Modified:
   B-Generate/trunk/   (props changed)
   B-Generate/trunk/BTest.pm
   B-Generate/trunk/Changes
   B-Generate/trunk/META.yml
   B-Generate/trunk/lib/B/Generate.pm
   B-Generate/trunk/lib/B/Generate.xs
   B-Generate/trunk/t/inspect-btest.t
   B-Generate/trunk/t/inspect-this.t
   B-Generate/trunk/t/op_list.t

Log:
merge from 1.13.

Modified: B-Generate/trunk/BTest.pm
==============================================================================
--- B-Generate/trunk/BTest.pm	(original)
+++ B-Generate/trunk/BTest.pm	Sat Aug 16 11:31:11 2008
@@ -18,10 +18,10 @@
      '2' =>	'BINOP',
      '|' =>	'LOGOP',
      '@' =>	'LISTOP',
-     '/' =>	'PMOP',  
-     '$' =>	'SVOP',  
+     '/' =>	'PMOP',
+     '$' =>	'SVOP',
      '"' =>	'PVOP',
-     '{' =>	'LOOP',    
+     '{' =>	'LOOP',
      ';' =>	'COP',,
      '#' =>	'PADOP',
     );
@@ -43,16 +43,16 @@
     } else {
 	warn "things depend on having B::Concise,-exec line";
     }
-    
+
     # later, we'll emit the low-level code
     if ($args{emit}) {
 	diag( "auto-gen'd, needs massaging\n",
 	      "testop(\$op,\n",
-	      map("\t $_ \t=> '$args{$_}',\n", 
+	      map("\t $_ \t=> '$args{$_}',\n",
 		  sort keys %args),
 	      "\t);\n");
     }
-    
+
     my $label = $args{label} || $args{name};
 
     if ($args{ref}) {
@@ -155,7 +155,7 @@
 sub parse_bcons {
     # digest B::Concise,-exec line, populate \%args with tests
     my $tests = shift;
-    
+
     my $line = $tests->{bcons};
     my ($cls, $nm, $arg, $flg, $to);
 
@@ -170,11 +170,11 @@
 	$tests->{ref} = 'B::'.$clsmap{$1}
     };
     $long =~ s/^(\w+)// && do {
-	$tests->{name}	//= $1;
-	$tests->{label}	//= $1;
-	$tests->{arg}	//= $long;
+	$tests->{name} = $1 unless defined $tests->{name};
+	$tests->{label} = $1 unless defined $tests->{label};
+	$tests->{arg} = $long unless defined $tests->{arg};
     };
-    
+
     # parse pub-flags
     if ($flg) {
 	my ($pub,$priv) = split m|/|, $flg;
@@ -218,35 +218,36 @@
 
 	# anomalous IV,NV behavior
 	# ie mismatch between bcons arg and tested obj
-	
-	/IV$/ && do {
-	    $tests->{sv} //= sub { "->NV \"".(shift)->NV() .'"' };
+	# 5.8 dont have NV methods for PVIVs
+
+	/IV$/ && $] > 5.010 && do {
+	    $tests->{sv} = sub { "->NV \"".(shift)->NV() .'"' } unless defined $tests->{sv};
 	};
 	/NV$/ && do {
-	    $tests->{sv} //= sub { "->NV \"".(shift)->NV() .'"' };
+	    $tests->{sv} = sub { "->NV \"".(shift)->NV() .'"' } unless defined $tests->{sv} ;
 	};
 	/PV$/ && do {
-	    $tests->{sv} //=
+	    $tests->{sv} =
 		sub {
 		    my $sv = shift;
 		    my $res;
 		    ok($res = $sv->PV, "->PV $res");
 		    ok($res = $sv->PVX, "->PVX $res");
 		    ok($res = $sv->CUR, "->CUR $res");
-		    ok($res = $sv->LEN, "->LEN $res");
+		    ok($res = $sv->LEN, "->LEN $res") if $] < 5.010;
 		    Dump($sv) unless $res;
 		    1;
-	    };
+	    } unless defined $tests->{sv};
 	};
 	/\*(w+)$/ && do {
 	    diag ("found gv[$1]\n");
 	    # $tests->{sv} //= sub { "->NV \"".(shift)->NV() .'"' };
 	};
 	/t(\d+)/ && do {
-	    $tests->{targ} //= $1;
+	    $tests->{targ} = $1 unless defined $tests->{targ};
 	};
     }
-    $tests->{type} //= B::opnumber($tests->{name});
+    $tests->{type} = B::opnumber($tests->{name}) unless defined $tests->{type};
 }
 
 
@@ -342,7 +343,7 @@
 each run and result is validated against values, typically something
 like this:
 
-    # f  <$> const[PV "1st thing in main"] sM 
+    # f  <$> const[PV "1st thing in main"] sM
     ok 99 - isa B::SVOP=SCALAR(0x8a32eec)
     ok 100 - const->flags is 34
     ok 101 - const->name is const
@@ -374,7 +375,7 @@
 explanatory text (see above).
 
 You have a lot of flexibility here; you can call any and all methods
-of the object returned by the $op->method ('sv' here). and you can 
+of the object returned by the $op->method ('sv' here). and you can
 
 
  - and enough rope to hang yourself.
@@ -459,12 +460,12 @@
 
 It should be possible to do something like:
 
-    testop($op[3], 
+    testop($op[3],
 	   bcons    => '<0> pushmark s ->4',
     	   sibling  => $op[4]);
 
 Since pushmark never has kids, its sibling is also its next, and
-should be testable.  CAVEAT - tests like this dont work yet TBD.
+should be testable.  CAVEAT - tests like this dont work yet. TBD
 
 =head2 test_all_ops(\@ops, $rendering);
 
@@ -483,11 +484,11 @@
 
 =head2 anomalous IV,NV behavior
 
-If you search the code for (heading), youll find code which attempts
-to address a discrepancy between how bconcise renders OP_CONST args
+If you search the code for (heading), you will find code which attempts
+to address a discrepancy between how B::Concise renders OP_CONST args
 (typically \[(IV|NV|PVIV) (\w)+\]) and what testing shows to be fatal.
 
-TODO Either turn them into exception tests, or examine B::Concise to
+TODO: Either turn them into exception tests, or examine B::Concise to
 see how its displaying/determining the type.
 
 =head1 Future Development
@@ -503,7 +504,7 @@
 due to brain-dead op-vector build, we only get ops which are not on a
 branch, excluding if blocks, for blocks, etc..
 
-Consider a B::Concise callback, or 
+Consider a B::Concise callback, or
 
 =head2 sentinel
 

Modified: B-Generate/trunk/Changes
==============================================================================
--- B-Generate/trunk/Changes	(original)
+++ B-Generate/trunk/Changes	Sat Aug 16 11:31:11 2008
@@ -1,5 +1,8 @@
 Revision history for Perl extension B::Generate.
 
+1.13 - (released by Reini Urban)
+  - same as 1.12_10
+
 1.12
   _01 - (against 5.10)
       - fixed a GV assertion error by adding isGV_with_GP
@@ -17,6 +20,25 @@
       - undo creeping 'feature'isms in tests (5.8 friendly)
       - static renderings dont port, drop test_all_ops in inspect-btest 
       - drop filegv from nextstate tests (caused uninit-strings in prints)
+  _07 Anton Berezin
+      - fixed a leak in find_cv_by_root()
+  _08 Reini Urban
+      - cop_label now in hints_hash (5.11 Change #33656)
+      - silence use64bitint warnings
+      - fix t/inspect-btest.t test count
+      - fix t/inspect-this.t not ok 568 - ->LEN 0.
+	skip all PV->LEN tests >= 5.10
+      - removed //= from BTest to support 5.8 and older
+  _09 Reini Urban
+      - fix 5.8.8 test PVIV->NV
+      - < 5.8 and blead DEBUGGING builds fail, the rest passes
+  _10 Dmitry Karasik 
+      - B::COP->new won't coredump on 5.10.0
+      - proper allocation of COP label
+      - add B::cv_pad for switching padlist during op generation
+      - add B::GVOP->new because B::PADOP is needed on threaded perls
+        where B::SVOP is normally used
+      - added missing t/op_list.t OP_LIST indices for 5.8 (Reini Urban)
 
 1.11 - (releaed by Josh Ben Jore)
   - rt#29257 - patches from Reini Urban & Jim Cromie

Modified: B-Generate/trunk/META.yml
==============================================================================
--- B-Generate/trunk/META.yml	(original)
+++ B-Generate/trunk/META.yml	Sat Aug 16 11:31:11 2008
@@ -1,6 +1,6 @@
 ---
 name: B-Generate
-version: 1.12_06
+version: 1.13
 author:
   - |-
     Simon Cozens, C<simon at cpan.org>
@@ -18,12 +18,12 @@
 provides:
   B::Generate:
     file: lib/B/Generate.pm
-    version: 1.12_06
+    version: 1.13
   B::OP:
     file: lib/B/Generate.pm
 no_index:
   package: B::OP
-generated_by: Module::Build version 0.280801
+generated_by: Module::Build version 0.280802
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.2.html
   version: 1.2

Modified: B-Generate/trunk/lib/B/Generate.pm
==============================================================================
--- B-Generate/trunk/lib/B/Generate.pm	(original)
+++ B-Generate/trunk/lib/B/Generate.pm	Sat Aug 16 11:31:11 2008
@@ -8,7 +8,7 @@
 require DynaLoader;
 use vars qw( @ISA $VERSION );
 @ISA = qw(DynaLoader);
-$VERSION = '1.12_06';
+$VERSION = '1.13';
 
 {
     # 'no warnings' does not work.
@@ -21,7 +21,7 @@
 
 package B::OP;
 use constant OP_LIST    => B::opnumber("list");    # MUST FIX CONSTANTS.
-use constant OPf_PARENS => 8;      # *MUST* *FIX* *CONSTANTS*.
+use constant OPf_PARENS => 8;      		   # *MUST* *FIX* *CONSTANTS*.
 use constant OPf_KIDS   => 4;
 
 # This is where we implement op.c in Perl. Sssh.
@@ -118,17 +118,16 @@
 
 1;
 __END__
-# Below is stub documentation for your module. You better edit it!
 
 =head1 NAME
 
-B::Generate - Create your own op trees. 
+B::Generate - Create your own op trees.
 
 =head1 SYNOPSIS
 
     use B::Generate;
     # Do nothing, slowly.
-      CHECK {
+    CHECK {
         my $null = new B::OP("null",0);
         my $enter = new B::OP("enter",0);
         my $cop = new B::COP(0, "hiya", 0);
@@ -143,7 +142,7 @@
         # Tell Perl where to find our tree.
         B::main_root($leave);
         B::main_start($enter);
-      }
+    }
 
 =head1 WARNING
 
@@ -267,7 +266,12 @@
 module. To find someone to actually maintain this, please try
 contacting perl5-porters.
 
-Josh Jore, Michael Schwern, Jim Cromie, Scott Walters.
+Josh Jore, Michael Schwern, Jim Cromie, Scott Walters, Reini Urban,
+Anton Berezin, Dmitry Karasik.
+
+Maintainership permissions do have:
+Artur Bergman, Chia-liang Kao, Anton Berezin, Jim Cromie, Joshua ben Jore,
+Michael G Schwern, Matt S Trout, Reini Urban, Scott Walters.
 
 =head1 LICENSE
 

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:31:11 2008
@@ -5,6 +5,7 @@
 #include "perlapi.h"
 #include "XSUB.h"
 
+
 #ifdef PERL_OBJECT
 #undef PL_op_name
 #undef PL_opargs 
@@ -14,6 +15,14 @@
 #define PL_op_desc (get_op_descs())
 #endif
 
+#ifdef PERL_CUSTOM_OPS
+#define OP_CUSTOM_OPS \
+    if (typenum == OP_CUSTOM) \
+        o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#else
+#define OP_CUSTOM_OPS
+#endif
+
 static char *svclassnames[] = {
     "B::NULL",
     "B::IV",
@@ -69,6 +78,12 @@
 
 static SV *specialsv_list[6];
 
+AV * tmp_comppad, * tmp_comppad_name;
+I32 tmp_padix, tmp_reset_pending;
+OP * tmp_op;
+
+CV * my_curr_cv = NULL;
+
 SV** my_current_pad;
 SV** tmp_pad;
 
@@ -79,13 +94,40 @@
 /* #define GEN_PAD */
 /* #define OLD_PAD */
 
+#define SAVE_VARS \
+{ \
+	tmp_comppad       = PL_comppad; \
+	tmp_comppad_name  = PL_comppad_name; \
+	tmp_padix         = PL_padix; \
+	tmp_reset_pending = PL_pad_reset_pending; \
+	tmp_pad           = PL_curpad; \
+	tmp_op            = PL_op; \
+	if ( my_curr_cv) { \
+		PL_comppad       = (AV*) AvARRAY(CvPADLIST(my_curr_cv))[1]; \
+		PL_comppad_name  = (AV*) AvARRAY(CvPADLIST(my_curr_cv))[0]; \
+		PL_padix         = AvFILLp(PL_comppad_name); \
+		PL_pad_reset_pending = 0; \
+	} \
+	PL_curpad = AvARRAY(PL_comppad); \
+}
+
+#define RESTORE_VARS \
+{ \
+	PL_op                = tmp_op; \
+	PL_comppad           = tmp_comppad; \
+	PL_curpad            = tmp_pad; \
+	PL_padix             = tmp_padix; \
+	PL_comppad_name      = tmp_comppad_name; \
+	PL_pad_reset_pending = tmp_reset_pending; \
+}
+
 void
 set_active_sub(SV *sv)
 {
     AV* padlist; 
     SV** svp;
     /* dTHX; */
-    //      sv_dump(SvRV(sv));
+    /* sv_dump(SvRV(sv)); */
     padlist = CvPADLIST(SvRV(sv));
     if(!padlist) {
         dTHX;
@@ -101,12 +143,11 @@
   dTHX;
   OP* root = o;
   SV* key;
-  SV* val;
   HE* cached;
 
   if(PL_compcv && SvTYPE(PL_compcv) == SVt_PVCV &&
         !PL_eval_root) {
-    //    printf("Compcv\n");
+      /*  printf("Compcv\n"); */
     if(SvROK(PL_compcv))
        sv_dump(SvRV(PL_compcv));
     return newRV((SV*)PL_compcv);
@@ -123,6 +164,7 @@
   
   cached = hv_fetch_ent(root_cache, key, 0, 0);
   if(cached) {
+    SvREFCNT_dec(key);
     return HeVAL(cached);
   }
   
@@ -176,6 +218,7 @@
     cached = hv_store_ent(root_cache, key, newRV((SV*)cv), 0);
   }
 
+  SvREFCNT_dec(key);
   return (SV*) HeVAL(cached);
 }
 
@@ -260,7 +303,7 @@
     (void)hv_iterinit(PL_custom_op_names);
     while ((ent = hv_iternext(PL_custom_op_names))) {
         if (strEQ(SvPV_nolen(hv_iterval(PL_custom_op_names,ent)),name))
-            return (void*)SvIV(hv_iterkeysv(ent));
+            return INT2PTR(void*,SvIV(hv_iterkeysv(ent)));
     }
 
     return 0;
@@ -272,7 +315,7 @@
 {
     if (!o)
         return OPc_NULL;
-    //    op_dump(o);
+    /* op_dump(o); */
     if (o->op_type == 0)
         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
 
@@ -400,7 +443,7 @@
 {
     OP *o;
     SV *result;
-
+    SAVE_VARS;
     SV **sparepad = PL_curpad;
     PL_curpad = AvARRAY(PL_comppad);
     OP *saveop = PL_op;
@@ -416,14 +459,10 @@
             sv = newSVsv(sv); // copy it unless it's cv
         }
     o = newSVOP(typenum, flags, SvREFCNT_inc(sv));
-#ifdef PERL_CUSTOM_OPS
-    if (typenum == OP_CUSTOM)
-        o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
-#endif
-    //PL_curpad = sparepad;
+    OP_CUSTOM_OPS;
+    RESTORE_VARS;
     result = sv_newmortal();
     sv_setiv(newSVrv(result, "B::SVOP"), PTR2IV(o));
-    PL_op = saveop;
     return result;
 }
 
@@ -499,6 +538,31 @@
     OUTPUT:
         RETVAL
 
+SV *
+B_cv_pad(...)
+    CV * old_cv = NO_INIT
+    PROTOTYPE: ;$
+    CODE:
+	old_cv = my_curr_cv;
+        if (items > 0) {
+            if (SvROK(ST(0))) {
+		IV tmp;
+                if (!sv_derived_from(ST(0), "B::CV"))
+                    Perl_croak(aTHX_ "Reference is not a B::CV object");
+        	tmp = SvIV((SV*)SvRV(ST(0)));
+		my_curr_cv = INT2PTR(CV*,tmp);
+            } else {
+                my_curr_cv = NULL;
+            }
+        }
+
+	if ( old_cv) {
+        	ST(0) = sv_newmortal();
+        	sv_setiv(newSVrv(ST(0), "B::CV"), PTR2IV(old_cv));
+	} else {
+		ST(0) = &PL_sv_undef;
+	}
+
 #define OP_desc(o)      PL_op_desc[o->op_type]
 
 MODULE = B::Generate    PACKAGE = B::OP         PREFIX = OP_
@@ -536,7 +600,7 @@
         B::OP           o
     CODE:
         if (items > 1)
-            o->op_ppaddr = (void*)SvIV(ST(1));
+            o->op_ppaddr = INT2PTR(void*,SvIV(ST(1)));
         RETVAL = PTR2IV((void*)(o->op_ppaddr));
     OUTPUT:
     RETVAL
@@ -561,13 +625,13 @@
             I32 old_comppad_name_fill = PL_comppad_name_fill;
             I32 old_min_intro_pending = PL_min_intro_pending;
             I32 old_max_intro_pending = PL_max_intro_pending;
-            // int old_cv_has_eval       = PL_cv_has_eval;
+            /* int old_cv_has_eval       = PL_cv_has_eval; */
             I32 old_pad_reset_pending = PL_pad_reset_pending;
             SV **old_curpad            = PL_curpad;
             AV *old_comppad           = PL_comppad;
             AV *old_comppad_name      = PL_comppad_name;
 
-            // PTR2UV
+            /* PTR2UV */
 
             PL_comppad_name      = (AV*)(*av_fetch(padlist, 0, FALSE));
             PL_comppad           = (AV*)(*av_fetch(padlist, 1, FALSE));
@@ -575,10 +639,12 @@
 
             PL_padix             = AvFILLp(PL_comppad_name);
             PL_pad_reset_pending = 0;
-            // <medwards> PL_comppad_name_fill appears irrelevant as long as you stick to pad_alloc, pad_swipe, pad_free.
-            // PL_comppad_name_fill = 0;
-            // PL_min_intro_pending = 0;
-            // PL_cv_has_eval       = 0;
+            /* <medwards> PL_comppad_name_fill appears irrelevant as long as you 
+	       stick to pad_alloc, pad_swipe, pad_free.
+	     * PL_comppad_name_fill = 0;
+	     * PL_min_intro_pending = 0;
+	     * PL_cv_has_eval       = 0;
+	     */
 
             o->op_targ = Perl_pad_alloc(aTHX_ 0, SVs_PADTMP);
 
@@ -586,7 +652,7 @@
             PL_comppad_name_fill = old_comppad_name_fill;
             PL_min_intro_pending = old_min_intro_pending;
             PL_max_intro_pending = old_max_intro_pending;
-            // PL_cv_has_eval       = old_cv_has_eval;
+            /* PL_cv_has_eval       = old_cv_has_eval; */
             PL_pad_reset_pending = old_pad_reset_pending;
             PL_curpad            = old_curpad;
             PL_comppad           = old_comppad;
@@ -663,23 +729,18 @@
     SV * class
     SV * type
     I32 flags
-    SV** sparepad = NO_INIT
     OP *o = NO_INIT
-    OP *saveop = NO_INIT
     I32 typenum = NO_INIT
     CODE:
-        sparepad = PL_curpad;
-        saveop = PL_op;
-        PL_curpad = AvARRAY(PL_comppad);
+	SAVE_VARS;
         typenum = op_name_to_num(type);
         o = newOP(typenum, flags);
 #ifdef PERL_CUSTOM_OPS
         if (typenum == OP_CUSTOM)
             o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
 #endif
-        PL_curpad = sparepad;
-        PL_op = saveop;
-            ST(0) = sv_newmortal();
+        RESTORE_VARS;
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::OP"), PTR2IV(o));
 
 void
@@ -688,17 +749,12 @@
     I32 flags
     char * label
     B::OP oldo
-    SV** sparepad = NO_INIT
     OP *o = NO_INIT
-    OP *saveop = NO_INIT
     CODE:
-        sparepad = PL_curpad;
-        saveop = PL_op;
-        PL_curpad = AvARRAY(PL_comppad);
+	SAVE_VARS;
         o = newSTATEOP(flags, label, oldo);
-        PL_curpad = sparepad;
-        PL_op = saveop;
-            ST(0) = sv_newmortal();
+        RESTORE_VARS;
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::LISTOP"), PTR2IV(o));
 
 B::OP
@@ -778,20 +834,17 @@
             first = Nullop;
         {
         I32 padflag = 0;
-        SV**sparepad = PL_curpad;
-        OP* saveop = PL_op; 
 
-        PL_curpad = AvARRAY(PL_comppad);
+	SAVE_VARS;
         typenum = op_name_to_num(type);
         o = newUNOP(typenum, flags, first);
 #ifdef PERL_CUSTOM_OPS
         if (typenum == OP_CUSTOM)
             o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
 #endif
-        PL_curpad = sparepad;
-        PL_op = saveop;
+        RESTORE_VARS;
         }
-            ST(0) = sv_newmortal();
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::UNOP"), PTR2IV(o));
 
 MODULE = B::Generate    PACKAGE = B::BINOP              PREFIX = BINOP_
@@ -850,12 +903,10 @@
             last = Nullop;
 
         {
-        SV**sparepad = PL_curpad;
-        OP* saveop = PL_op;
         I32 typenum = op_name_to_num(type);
 
-        PL_curpad = AvARRAY(PL_comppad);
-        
+	SAVE_VARS;
+
         if (typenum == OP_SASSIGN || typenum == OP_AASSIGN) 
             o = newASSIGNOP(flags, first, 0, last);
         else {
@@ -866,10 +917,9 @@
 #endif
         }
 
-        PL_curpad = sparepad;
-        PL_op = saveop;
+        RESTORE_VARS;
         }
-            ST(0) = sv_newmortal();
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::BINOP"), PTR2IV(o));
 
 MODULE = B::Generate    PACKAGE = B::LISTOP             PREFIX = LISTOP_
@@ -912,20 +962,17 @@
             last = Nullop;
 
         {
-        SV**sparepad = PL_curpad;
-        OP* saveop   = PL_op;
         I32 typenum = op_name_to_num(type);
 
-        PL_curpad = AvARRAY(PL_comppad);
+	SAVE_VARS;
         o = newLISTOP(typenum, flags, first, last);
 #ifdef PERL_CUSTOM_OPS
         if (typenum == OP_CUSTOM)
             o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
 #endif
-        PL_curpad = sparepad;
-        PL_op = saveop;
+	RESTORE_VARS;
         }
-            ST(0) = sv_newmortal();
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::LISTOP"), PTR2IV(o));
 
 MODULE = B::Generate    PACKAGE = B::LOGOP              PREFIX = LOGOP_
@@ -968,19 +1015,16 @@
             last = Nullop;
 
         {
-        SV**sparepad = PL_curpad;
-        OP* saveop   = PL_op;
         I32 typenum  = op_name_to_num(type);
-        PL_curpad = AvARRAY(PL_comppad);
+	SAVE_VARS;
         o = newLOGOP(typenum, flags, first, last);
 #ifdef PERL_CUSTOM_OPS
         if (typenum == OP_CUSTOM)
             o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
 #endif
-        PL_curpad = sparepad;
-        PL_op = saveop;
+        RESTORE_VARS;
         }
-            ST(0) = sv_newmortal();
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::LOGOP"), PTR2IV(o));
 
 void
@@ -1035,14 +1079,11 @@
             elseo = Nullop;
 
         {
-        SV**sparepad = PL_curpad;
-        OP* saveop   = PL_op;
-        PL_curpad = AvARRAY(PL_comppad);
+        SAVE_VARS;
         o = newCONDOP(flags, first, last, elseo);
-        PL_curpad = sparepad;
-        PL_op = saveop;
+        RESTORE_VARS;
         }
-            ST(0) = sv_newmortal();
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::LOGOP"), PTR2IV(o));
 
 B::OP
@@ -1165,7 +1206,30 @@
 SVOP_gv(o)
         B::SVOP o
 
-void
+#define NEW_SVOP(OP_class,B_class)                                          \
+{                                                                           \
+    OP *o;                                                                  \
+    SV* param;                                                              \
+    I32 typenum;                                                            \
+    SAVE_VARS;                                                              \
+    typenum = op_name_to_num(type); /* XXX More classes here! */            \
+    if (typenum == OP_GVSV) {                                               \
+        if (*(SvPV_nolen(sv)) == '$')                                       \
+            param = (SV*)gv_fetchpv(SvPVX(sv)+1, TRUE, SVt_PV);             \
+        else                                                                \
+        Perl_croak(aTHX_                                                    \
+        "First character to GVSV was not dollar");                          \
+    } else                                                                  \
+        param = newSVsv(sv);                                                \
+    o = OP_class(typenum, flags, param);                                    \
+    OP_CUSTOM_OPS                                                           \
+    RESTORE_VARS;                                                           \
+    ST(0) = sv_newmortal();                                                 \
+    sv_setiv(newSVrv(ST(0), B_class), PTR2IV(o));                           \
+}                                                                                 
+
+
+SV*
 SVOP_new_svrv(class, type, flags, sv)
     SV * class
     SV * type
@@ -1181,9 +1245,8 @@
     SV * type
     I32 flags
     SV * sv
-    CODE:
-        ST(0) = __svop_new(aTHX_ class, type, flags, sv);
-        
+    CODE: 
+         NEW_SVOP(newSVOP, "B::SVOP");
 
 
 #define PADOP_padix(o)  o->op_padix
@@ -1192,6 +1255,21 @@
                           && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
                          ? (GV*)PL_curpad[o->op_padix] : Nullgv)
 
+MODULE = B::Generate    PACKAGE = B::GVOP              PREFIX = GVOP_
+
+SV *
+GVOP_new(class, type, flags, sv)
+    SV * class
+    SV * type
+    I32 flags
+    SV * sv
+    CODE: 
+#ifdef USE_ITHREADS
+         NEW_SVOP(newPADOP, "B::PADOP");
+#else
+         NEW_SVOP(newSVOP, "B::SVOP");
+#endif
+
 MODULE = B::Generate    PACKAGE = B::PADOP              PREFIX = PADOP_
 
 PADOFFSET
@@ -1257,7 +1335,9 @@
     OUTPUT:
         RETVAL
 
+#if PERL_VERSION < 11
 #define COP_label(o)    o->cop_label
+#endif
 #define COP_stashpv(o)  CopSTASHPV(o)
 #define COP_stash(o)    CopSTASH(o)
 #define COP_file(o)     CopFILE(o)
@@ -1271,10 +1351,14 @@
 MODULE = B::Generate    PACKAGE = B::COP                PREFIX = COP_
 
 
+#if PERL_VERSION < 11
+
 char *
 COP_label(o)
         B::COP  o
 
+#endif
+
 char *
 COP_stashpv(o)
         B::COP  o
@@ -1353,6 +1437,10 @@
 
 =cut
 
+#ifndef CopLABEL_alloc
+#define CopLABEL_alloc(x) Perl_savepv(aTHX_ x)
+#endif
+
 B::COP
 COP_new(class, flags, name, sv_first)
     SV * class
@@ -1377,14 +1465,21 @@
             first = Nullop;
 
         {
-        SV**sparepad = PL_curpad;
-        OP* saveop = PL_op;
-        PL_curpad = AvARRAY(PL_comppad);
-        o = newSTATEOP(flags, name, first);
-        PL_curpad = sparepad;
-        PL_op = saveop;
+#if PERL_VERSION >= 10
+        yy_parser* saveparser = PL_parser, dummyparser;
+        if ( PL_parser == NULL) {
+            PL_parser = &dummyparser;
+            PL_parser-> copline = NOLINE;
         }
-            ST(0) = sv_newmortal();
+#endif
+        SAVE_VARS;
+        o = newSTATEOP(flags, CopLABEL_alloc(name), first);
+        RESTORE_VARS;
+#if PERL_VERSION >= 10
+        PL_parser = saveparser;
+#endif
+        }
+        ST(0) = sv_newmortal();
         sv_setiv(newSVrv(ST(0), "B::COP"), PTR2IV(o));
 
 MODULE = B::Generate  PACKAGE = B::SV  PREFIX = Sv
@@ -1442,7 +1537,8 @@
         RETVAL = mycv;
     OUTPUT:
         RETVAL
-        
+       
+ 
 
 MODULE = B::Generate    PACKAGE = B::PV         PREFIX = Sv
 

Modified: B-Generate/trunk/t/inspect-btest.t
==============================================================================
--- B-Generate/trunk/t/inspect-btest.t	(original)
+++ B-Generate/trunk/t/inspect-btest.t	Sat Aug 16 11:31:11 2008
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 30;
+use Test::More tests => 31;
 use_ok 'B';
 use_ok 'B::Generate';
 

Modified: B-Generate/trunk/t/inspect-this.t
==============================================================================
--- B-Generate/trunk/t/inspect-this.t	(original)
+++ B-Generate/trunk/t/inspect-this.t	Sat Aug 16 11:31:11 2008
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 655;
+use Test::More tests => $] < 5.010 ? 658 : 648; # skip PV->LEN tests on 5.10
 use_ok 'B';
 
 #use_ok 'B::Generate'; # cannot use here, due to clash with B::Concise

Modified: B-Generate/trunk/t/op_list.t
==============================================================================
--- B-Generate/trunk/t/op_list.t	(original)
+++ B-Generate/trunk/t/op_list.t	Sat Aug 16 11:31:11 2008
@@ -14,6 +14,14 @@
     145 => "5.011000",
     142 => "5.010000",
     141 => "5.008008",	# probably should be 5.008(00[12])?
+    141 => "5.008007",
+    141 => "5.008006",
+    141 => "5.008005",
+    141 => "5.008004",
+    141 => "5.008003",
+    141 => "5.008002",
+    141 => "5.008001",
+    141 => "5.008000",
     );
 
 my $got = B::opnumber("list");


More information about the Jifty-commit mailing list