[Jifty-commit] r5465 - in B-Generate/vendor: . t

Jifty commits jifty-commit at lists.jifty.org
Fri May 16 03:12:26 EDT 2008


Author: clkao
Date: Fri May 16 03:12:26 2008
New Revision: 5465

Added:
   B-Generate/vendor/BTest.pm
   B-Generate/vendor/t/inspect-btest.t
   B-Generate/vendor/t/inspect-this.t
   B-Generate/vendor/t/op_list.t
   B-Generate/vendor/t/op_list_bgen.t
Modified:
   B-Generate/vendor/Build.PL
   B-Generate/vendor/Changes
   B-Generate/vendor/MANIFEST
   B-Generate/vendor/META.yml
   B-Generate/vendor/lib/B/Generate.pm
   B-Generate/vendor/lib/B/Generate.xs

Log:
import B::Generate 1.12_06

Added: B-Generate/vendor/BTest.pm
==============================================================================
--- (empty file)
+++ B-Generate/vendor/BTest.pm	Fri May 16 03:12:26 2008
@@ -0,0 +1,514 @@
+#!perl
+
+# package BTest;
+# pseudo-package, like test.pl, pollutes namespace.  This is currently
+# necessary to call Test::More functions (maybe just use it, wo plan)
+
+# goal is to write a main thats simple enough to inspect, then do so
+# using B-Gen (B too?), and verify various op details
+
+use B;
+use B::Concise;
+use Devel::Peek;
+
+my %clsmap =
+    (
+     '0' =>	'OP',
+     '1' =>	'UNOP',
+     '2' =>	'BINOP',
+     '|' =>	'LOGOP',
+     '@' =>	'LISTOP',
+     '/' =>	'PMOP',  
+     '$' =>	'SVOP',  
+     '"' =>	'PVOP',
+     '{' =>	'LOOP',    
+     ';' =>	'COP',,
+     '#' =>	'PADOP',
+    );
+
+BEGIN {
+    print "$_ => $clsmap{$_}\n" for keys %clsmap;
+}
+
+
+sub testop {
+    # test that $op can execute methods given as keys in %args.
+
+    my ($op, %args) = @_;
+
+    if ($args{bcons}) {
+	# get testable stuff by parsing B::Concise line
+	parse_bcons(\%args);
+	pass($args{bcons}); # annotation
+    } 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", 
+		  sort keys %args),
+	      "\t);\n");
+    }
+    
+    my $label = $args{label} || $args{name};
+
+    if ($args{ref}) {
+	ok(ref $op eq $args{ref}, "$label isa ". $op);
+    } else {
+	# show reftype wo test, pls convert cases
+	ok(1, "is a " . $op); # ref $op);
+    }
+
+    delete @args{qw/ arg bcons ref pass label to class emit /};
+
+    # each key is a method on $op, so run them,
+    # test retval against key's value (and type)
+    for my $k (sort keys %args) {
+
+	if (ref $args{$k} eq "CODE") {
+	    # inspect the property with the code
+	    my $res = eval { $args{$k}->($op->$k) };
+	    #my $res = $args{$k}->($op->$k);
+	    ok(!$@, "$label->$k()$res $@");
+	}
+	elsif (ref $args{$k} eq "Regexp") {
+	    like( $op->$k, $args{$k},
+		  "$label->$k is like $args{$k}" );
+	}
+	elsif (ref $args{$k} eq "ARRAY") {
+	    # actual value in
+	    ok( grep( $op->$k() eq $_, @{$args{$k}}),
+		"$label->$k in @{$args{$k}}" );
+	}
+	elsif (defined $args{$k}) {
+	    is( $op->$k(), $args{$k},
+		"$label->$k is $args{$k}" );
+	}
+	else {
+	    # method's return is unconstrained
+	    ok( $op->$k(), "$label->$k is ok: ". $op->$k());
+	}
+    }
+
+    # try various other methods, just to test stability/robustness
+    for my $k (qw( sibling first last other children )) {
+	next if $args{$k}; # already did it	
+	if (my $do = $op->can($k)) {
+	    ok ($op->$do, "$label->$k: ". $op->$do);
+	}
+    }
+}
+
+sub test_self_ops {
+    my %args = @_;
+
+    # called from a file-under-test, we get its B::Concise,-exec,-main
+    # rendering, copy its exec-ops, and submit to test_all_ops
+
+    my $walker = B::Concise::compile(qw( -exec -main -nobanner -src ));
+    B::Concise::walk_output(\my $buf);
+    $walker->('-main','-nobanner');
+    diag("raw prog\n".$buf) if $args{-v} && $args{-v}>1;
+
+    my @render = split /\n/, $buf;
+    shift @render;
+
+    # kludgy filter to exclude any branches
+    @render = grep /^\w+\s{1,2}</, @render;
+    diag(join "\n", "main op-vector", @render) if $args{-v};
+
+    # KLUDGE - if B::Generate is 'used', B::Concise::compile() call
+    # above fails badly:
+    # Can't locate object method "NAME" via package "B::CV" at
+    # /usr/local/lib/perl5/5.10.0/i686-linux-thread-multi/B/Concise.pm
+    # line 831.
+
+    eval "use B::Generate";
+
+    # OTOH, if we dont require it here, we get failures in sv tests
+    # because B returns B::SPECIAL objects rather than the B::SVOPs
+    # that B::Generate returns, which respond 'properly' to ->sv()
+    # methods
+
+    my $start = B::main_start();
+    my $next = $start;
+    eval {
+	do { push @exe, $next }
+	while ($next = $next->next);
+	# eventually dies on B::NULL
+    };
+
+    while (1) {
+	my $op = shift @exe;
+	my $ln = shift @render;
+	last unless $op and $ln;
+	testop($op, bcons => $ln, emit => $args{-v});
+    }
+}
+
+
+sub istrue { (shift) }
+
+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);
+
+    $tests->{to} = $1	if $line =~ s/\s*->(.*)$//;
+    $tests->{arg} = $1	if $line =~ s/[\(\[](.+)[\]\)]//;
+
+    # parse normalized line now
+    (undef, $cls, $long, $flg) = split /\s+/, $line;
+
+    $cls =~ /<(.)>/ && do {
+	# convert <.> into 'B::*OP'
+	$tests->{ref} = 'B::'.$clsmap{$1}
+    };
+    $long =~ s/^(\w+)// && do {
+	$tests->{name}	//= $1;
+	$tests->{label}	//= $1;
+	$tests->{arg}	//= $long;
+    };
+    
+    # parse pub-flags
+    if ($flg) {
+	my ($pub,$priv) = split m|/|, $flg;
+	$_ = $pub;
+	/v/  && do { $tests->{flags} |= &B::OPf_WANT_VOID };
+	/s/  && do { $tests->{flags} |= &B::OPf_WANT_SCALAR };
+	/l/  && do { $tests->{flags} |= &B::OPf_WANT_LIST };
+	/K/  && do { $tests->{flags} |= &B::OPf_KIDS };
+	/P/  && do { $tests->{flags} |= &B::OPf_PARENS };
+	/R/  && do { $tests->{flags} |= &B::OPf_REF };
+	/S/  && do { $tests->{flags} |= &B::OPf_STACKED };
+	/M/  && do { $tests->{flags} |= &B::OPf_MOD };
+	/\*/ && do { $tests->{flags} |= &B::OPf_SPECIAL };
+
+	# check truth of privates (simple)
+	$tests->{private} = \&istrue if $priv;
+    }
+    # parse '(arg)'
+    if ($tests->{name} =~ /(next|db)state/) {
+
+	# allow both 'nextstate' & 'dbstate'
+	$tests->{name}	= qr/(next|db)state/;
+	$tests->{label}	= 'nextstate';
+	$tests->{type}	= [ B::opnumber('nextstate'),
+			    B::opnumber('dbstate') ];
+
+	# parse arg, collect more testable info
+	my ($pkg, $num, $prog, $ln) = split /(?:\s+|:)/, $tests->{arg};
+	$tests->{file} = qr/$prog/;
+	$tests->{line} = $ln;
+	# $tests->{filegv} = undef;	# no value constraint, just run it
+    }
+    elsif ($tests->{arg}) {
+	# dig into args (for const ops)
+	my ($t,$v) = split /\s+/, $tests->{arg};
+
+	# behavior expected apriori
+	# $tests->{sv} //= sub { "->$t \"".(shift)->$t() .'"' };
+
+	$_ = $t;
+
+	# anomalous IV,NV behavior
+	# ie mismatch between bcons arg and tested obj
+	
+	/IV$/ && do {
+	    $tests->{sv} //= sub { "->NV \"".(shift)->NV() .'"' };
+	};
+	/NV$/ && do {
+	    $tests->{sv} //= sub { "->NV \"".(shift)->NV() .'"' };
+	};
+	/PV$/ && do {
+	    $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");
+		    Dump($sv) unless $res;
+		    1;
+	    };
+	};
+	/\*(w+)$/ && do {
+	    diag ("found gv[$1]\n");
+	    # $tests->{sv} //= sub { "->NV \"".(shift)->NV() .'"' };
+	};
+	/t(\d+)/ && do {
+	    $tests->{targ} //= $1;
+	};
+    }
+    $tests->{type} //= B::opnumber($tests->{name});
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+BTest - helper for testing B module
+
+=head1 SYNOPSIS
+
+This module supports easy testing/torture of B module with a 2 layer
+API.  The low-level function provides power, extensibility, and rope,
+the high-level function provides ease of use by deriving OPs to test
+from the test program itself.
+
+    # Low Level API
+    # test a single op by calling %tests keys as methods,
+    # and comparing returned value to the stored value
+    testop($op, %tests);
+
+    # High Level API
+    # test ops in main_start
+    test_self_ops(-v => 2);
+
+=head1 PURPOSE
+
+B is a tricky yet foundational module which allows a sophisticated
+user to inspect the optree of a perl program.  B is difficult to use
+correctly, and prone to fatal errors otherwize.  It is also
+undertested.
+
+BTest's goals are to make -
+
+    - it easy to do cursory testing of B on ops
+    - it possible to do deeper tests (inspect op args)
+    - easy stress testing
+    - the test output self explanatory (tutorial value)
+    - the tests look like specifications
+    - tests are extensible
+    - it easier to learn how to use B well
+    - framework gives place to hang further knowledge/kludges
+
+=head1 DESCRIPTION
+
+BTest has a 2 level API which gives simplicity (test_self_ops) and
+power (testop) in support of testing the B module.
+
+=head2 test_self_ops(%args)
+
+This function extracts the optree of the main program, and uses a
+B::Concise rendering of it to determine runnable tests for each op,
+and then run those tests.  This provides a baseline of coverage and
+test sophistication which can improve over time.
+
+It should be called from a file-under-test, immediately after some
+main-code (ie not subroutine code).
+
+NOTES:
+
+Currently, we throw away any branches rendered by B::Concise, since
+they are not part of the exec-order OP-vector.  Later, it may become
+obvious how to use them.
+
+=head2 testop($op, %tests)
+
+testop examines $op, based upon user defined %tests.  Each key (aside
+from special ones..) is invoked as an OP method C<< $op->$k() >>, and
+the result is validated against $tests{$k}, in a manner based upon the
+value's type:
+
+    scalar - is()
+    regexp - like()
+    array  - grep { $retval eq $_ } @array
+    undef  - call $op->$k(), dont test retval
+    CODE   - call $code->($op->$k()), let code validate retval
+
+This gives brevity and flexibilty, letting users run methods on one op
+that would be inappropriate (or even segv!) on another.  Consider:
+
+    testop($op,
+       bcons   => 'a  <$> const[PV "1st thing in main"] sM',
+       name    => 'const',
+       flags   => &B::OPf_WANT_SCALAR | &B::OPf_MOD, # 32+2
+       private => 0,
+       type    => 5,
+       sv      => sub { '->PV "'.(shift)->PV .'"' },
+    );
+
+Here, all keys (except bcons) are legitimate methods on $op, they're
+each run and result is validated against values, typically something
+like this:
+
+    # 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
+    ok 102 - const->private is 0
+    ok 103 - const->sv()->PV "1st thing in main"
+    ok 104 - const->type is 5
+
+Some observations:
+
+The bcons param is issued as a diagnostic message prior to the tests
+being run.  This groups the tests visually.
+
+Tests 100+ take the name param and use it as part of the test
+description, giving an appearance of symbolic representation.
+
+Test 99 gives "$op" rather than ref $op.  This prints the op's address
+too, allowing user/tester to inspect linkage between ops.
+
+One other thing not evident here - the test descriptions are
+constructed from actual values returned by method calls.  This can be
+confusing when the test fails and the description suggests otherwize.
+However, doing so makes the descriptions more expressive and
+informative when the test passes (the normal case).
+
+=head3 sv => sub { '->PV "'.(shift)->PV .'"' },
+
+Due to presence of this pair, testop() invokes C<< $code->($op->sv);
+>>.  This particular callback fetches the string value, prefixed with
+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 
+
+
+ - and enough rope to hang yourself.
+If the constant was an integer, then ->PV would probably be bad.
+
+NB: this sv example was developed to test B::Generate, which extends
+B's API.  Im uncertain whether this example relys on the extensions.
+
+Also, consider this example:
+
+    testop($op2,
+       bcons => 'e  <$> const[IV 1] sM ',
+       sv => sub { "->NV ".(shift)->NV }, # ??? why NV not IV
+       name => 'const',
+       flags => &B::OPf_MOD | &B::OPf_WANT_SCALAR);
+
+Here we have an anomaly (bug?) in that the B::Concise rendering says
+'const[IV]', but the code that worked (and didnt crash!) was C<<
+(shift)->NV >>, not C<< (shift)->IV >>
+
+=head3 ref => 'B::OP'
+
+This is the 1st special %test key; it's not treated as a method, but
+rather as C<< ok(ref($op), $test{ref}, "isa $op") >>.
+
+=head3 class => 'B::OP'
+
+This is TBD, since B::class() fails when called as a method.
+
+=head3 bcons => 'string'
+
+This param is truly special - the value is parsed as a B::Concise
+line, and a set of hypotheses are generated.  Each is stored in %tests
+unless the caller has provided their own.  These new tests are then
+run along with user provided ones.
+
+Currently, at least the following tests are synthesized:
+
+type - this pair is created by calling B::opnumber($tests{name}).
+This is a round-trip test that is effectively predestined to pass, but
+which exersizes B code more than otherwize.  A few tricks are played
+here so that nextstate and dbstate are 'equivalent', which prevents
+false failures when running under debugger.
+
+ref - this is populated based upon a /<.>/ match on the bcons param.
+The resulting test has little value, since it uses ref($op), not B
+code.  It is however useful to reinforce the 1-many relationship
+between op-class and op-type.
+
+For nextstate ops, the arg is parsed, and file, line tests are added.
+
+=head3 unspecified tests
+
+Since one goal is to *bang* on B as much as possible, we also try
+various B::*OP methods, protected by C<< $op->can($method) >>.  In
+this example, the last 4 tests are done automatically:
+
+    # t  <@> list vKPM/128
+    ok 159 - list isa B::LISTOP=SCALAR(0xa271a2c)
+    ok 160 - list->flags is 45
+    ok 161 - list->name is list
+    ok 162 - list->type is 142
+    ok 163 - list->sibling: B::COP=SCALAR(0xa290bac)
+    ok 164 - list->first: B::OP=SCALAR(0xa290bac)
+    ok 165 - list->last: B::OP=SCALAR(0xa290bac)
+    ok 166 - list->children: 3
+
+These tests cannot fail, except by crashing, since no expected result
+is available.  By running them automatically, we tacitly suggest that
+they be converted to real tests.  Specifically, adding C<< children =>
+3 >> to %tests will verify that there are really 3 kid ops.
+
+=head3 testing siblings, first, last, other
+
+With testop() its possible to test for proper linkage; given a fixed
+array of ops in exec-order, and knowledge of the ops themselves:
+
+  6     <1> entersub[t2] vKS/TARG,1 ->7
+  -        <1> ex-list K ->6
+  3           <0> pushmark s ->4
+  4           <$> const[PV "B"] sM ->5
+
+It should be possible to do something like:
+
+    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.
+
+=head2 test_all_ops(\@ops, $rendering);
+
+This mid-level function takes a B::Concise,-exec rendering, parses it
+into lines, then calls testop($op, bcons => $line) to test each.  This
+makes it easy to leverage testop's bcons handling.
+
+It is used by test_self_ops(), which adds the ability to get the
+rendering automatically.
+
+Its weakness is that it hides testop's ability to incorporate
+customized user tests.  An emit-source may be added to improve this.
+
+
+=head1 Current Issues
+
+=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
+(typically \[(IV|NV|PVIV) (\w)+\]) and what testing shows to be fatal.
+
+TODO Either turn them into exception tests, or examine B::Concise to
+see how its displaying/determining the type.
+
+=head1 Future Development
+
+=head2 more parse_bcons() refinements
+
+refactor parse_bcons() op-specific processing, provide plug-on
+test-subs modelled after anonymous subs probing object returned from
+'->sv', 1st developed using testop.
+
+=head2 follow branches
+
+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 
+
+=head2 sentinel
+
+test_self_ops() could also act as a sentinel, whereby only main-code
+prior to the call is used as B OP cannon-fodder.  OTOH, theres no
+obvious reason why this is useful.
+
+=cut

Modified: B-Generate/vendor/Build.PL
==============================================================================
--- B-Generate/vendor/Build.PL	(original)
+++ B-Generate/vendor/Build.PL	Fri May 16 03:12:26 2008
@@ -28,6 +28,7 @@
     no_index       => { package => 'B::OP', },
     requires       => {
         perl                 => '5.5.62',
+        'B'                  => '1.09', # see rt29257 re OP_LIST
         'ExtUtils::CBuilder' => 0,
         'Module::Build'      => 0,
     },

Modified: B-Generate/vendor/Changes
==============================================================================
--- B-Generate/vendor/Changes	(original)
+++ B-Generate/vendor/Changes	Fri May 16 03:12:26 2008
@@ -1,5 +1,26 @@
 Revision history for Perl extension B::Generate.
 
+1.12
+  _01 - (against 5.10)
+      - fixed a GV assertion error by adding isGV_with_GP
+      - silenced a const warning (another remains in COP_warnings)
+  _02 - ifdef'd PMOP_precomp, removed in 5.11
+  _03 - add a call to isGV_with_GP, 5.11 version of COP_warnings (released)
+  _04 - isGV_with_GP is 5.10 only
+  _0501
+      - reduced dependency on B => 1.09
+      - added broken/failing t/synopsis.t - very raw, moving ahead
+      - started build.nt - attempt to loop over opnames and construct ops
+  _0502
+      - added BTest.pm and several files using it
+  _06 - "duh, thanks CPANTS" release
+      - 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)
+
+1.11 - (releaed by Josh Ben Jore)
+  - rt#29257 - patches from Reini Urban & Jim Cromie
+
 1.10
   - License clarification. B::Generate is available under the same
     terms as perl. Dist now includes copy of Artistic and GPL licenses.

Modified: B-Generate/vendor/MANIFEST
==============================================================================
--- B-Generate/vendor/MANIFEST	(original)
+++ B-Generate/vendor/MANIFEST	Fri May 16 03:12:26 2008
@@ -8,4 +8,9 @@
 MANIFEST
 META.yml
 t/basic.t
+BTest.pm
+t/inspect-btest.t
+t/inspect-this.t
+t/op_list.t
+t/op_list_bgen.t
 typemap

Modified: B-Generate/vendor/META.yml
==============================================================================
--- B-Generate/vendor/META.yml	(original)
+++ B-Generate/vendor/META.yml	Fri May 16 03:12:26 2008
@@ -1,6 +1,6 @@
 ---
 name: B-Generate
-version: 1.11
+version: 1.12_06
 author:
   - |-
     Simon Cozens, C<simon at cpan.org>
@@ -10,6 +10,7 @@
 resources:
   license: http://dev.perl.org/licenses/
 requires:
+  B: 1.09
   ExtUtils::CBuilder: 0
   Module::Build: 0
   perl: 5.5.62
@@ -17,7 +18,7 @@
 provides:
   B::Generate:
     file: lib/B/Generate.pm
-    version: 1.11
+    version: 1.12_06
   B::OP:
     file: lib/B/Generate.pm
 no_index:

Modified: B-Generate/vendor/lib/B/Generate.pm
==============================================================================
--- B-Generate/vendor/lib/B/Generate.pm	(original)
+++ B-Generate/vendor/lib/B/Generate.pm	Fri May 16 03:12:26 2008
@@ -8,7 +8,7 @@
 require DynaLoader;
 use vars qw( @ISA $VERSION );
 @ISA = qw(DynaLoader);
-$VERSION = '1.11';
+$VERSION = '1.12_06';
 
 {
     # 'no warnings' does not work.
@@ -20,7 +20,7 @@
 }
 
 package B::OP;
-use constant OP_LIST    => 141;    # MUST FIX CONSTANTS.
+use constant OP_LIST    => B::opnumber("list");    # MUST FIX CONSTANTS.
 use constant OPf_PARENS => 8;      # *MUST* *FIX* *CONSTANTS*.
 use constant OPf_KIDS   => 4;
 

Modified: B-Generate/vendor/lib/B/Generate.xs
==============================================================================
--- B-Generate/vendor/lib/B/Generate.xs	(original)
+++ B-Generate/vendor/lib/B/Generate.xs	Fri May 16 03:12:26 2008
@@ -1,3 +1,4 @@
+/* -*- C -*- */
 #define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
@@ -154,7 +155,11 @@
              CvROOT(sv) == root
              ) {
             cv = (CV*) sv;
-          } else if( SvTYPE(sv) == SVt_PVGV && GvGP(sv) &&
+          } else if( SvTYPE(sv) == SVt_PVGV && 
+#if PERL_VERSION >= 10
+	  	    isGV_with_GP(sv) && 
+#endif
+		    GvGP(sv) &&
                     GvCV(sv) && !SvVALID(sv) && !CvXSUB(GvCV(sv)) &&
                     CvROOT(GvCV(sv)) == root)
                      {
@@ -224,7 +229,10 @@
     if (PL_custom_op_names) {
         HE* ent;
         SV* value;
-        /* This is sort of a hv_exists, backwards */
+
+        /* This is sort of a hv_exists, backwards - since custom-ops
+	   are stored using their pp-addr as key, we must scan the
+	   values */
         (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)),wanted))
@@ -500,7 +508,7 @@
     OUTPUT:
     RETVAL
 
-char *
+const char *
 OP_desc(o)
         B::OP           o
 
@@ -1076,6 +1084,8 @@
 PMOP_pmflags(o)
         B::PMOP         o
 
+#if PERL_VERSION < 11
+
 void
 PMOP_precomp(o)
         B::PMOP         o
@@ -1086,6 +1096,8 @@
         if (rx)
             sv_setpvn(ST(0), rx->precomp, rx->prelen);
 
+#endif
+
 #define SVOP_sv(o)     (cSVOPo_sv)
 #define SVOP_gv(o)     ((GV*)cSVOPo_sv)
 
@@ -1276,14 +1288,51 @@
 /* TODO: This throws a warning that cop_warnings is (STRLEN*)
    while I am casting to (SV*). The typedef converts special
    values of (STRLEN*) into SV objects. Hope the initial pointer
-   casting isn't a problem. */
+   casting isn't a problem.
+
+   New code for 5.11 is loosely based upon patch 27786 changes to
+   B.xs, but avoids calling the static function added there.
+   XXX: maybe de-static that function
+ */
 
 =cut
 
+#if PERL_VERSION < 11
+
 B::SV
 COP_warnings(o)
         B::COP  o
 
+#else
+
+void
+COP_warnings(o)
+        B::COP  o
+
+#endif
+
+=pod
+
+/*
+
+   another go: with blead at 33056, get another arg2 mismatch to newSVpv
+   in this code.  Turns out that COP_warnings(o) returns void now.
+   So I hope to comment out this XS, and get B's version instead.
+   sofar sogood.
+
+B::SV
+COP_warnings(o)
+        B::COP  o
+    CODE:
+	RETVAL = newSVpv(o->cop_warnings, 0);
+
+#endif
+
+
+*/
+
+=cut
+
 B::COP
 COP_new(class, flags, name, sv_first)
     SV * class

Added: B-Generate/vendor/t/inspect-btest.t
==============================================================================
--- (empty file)
+++ B-Generate/vendor/t/inspect-btest.t	Fri May 16 03:12:26 2008
@@ -0,0 +1,60 @@
+#!perl
+
+use Test::More tests => 30;
+use_ok 'B';
+use_ok 'B::Generate';
+
+#use lib '.';
+use BTest;
+
+# Store ops in exe order, so linkage tests are easier.  Ops which have
+# been optimized away cannot be tested, but theyre B::NULL anyway,
+# which doesnt support any methods.  There are siblings which havent
+# been pruned, which should be testable. (premonition?)
+
+my $next = B::main_start();
+eval {
+    do { push @exe, $next }
+    while ($next = $next->next);
+    # eventually dies on B::NULL
+};
+
+my $root = B::main_root();
+testop($root,
+       bcons => 'e9 <@> leave[1 ref] vKP/REFC ->(end)',
+       name => 'leave',
+    );
+my $rn = $root->next;
+isa_ok( $rn, "B::NULL", "root->next is B::NULL");
+
+testop($exe[3],
+       name => 'const',
+       bcons => '4  <$> const[PV "B"] sM ',
+       class => 'B::SVOP',
+       flags => &B::OPf_WANT_SCALAR | &B::OPf_MOD,
+       sv => sub {
+	   my $sv = shift;
+	   my $res =
+	       '->PV "' .$sv->PV ."\"\n" .
+	       '->PVX "' .$sv->PVX ."\"\n" .
+	       '->CUR "' .$sv->CUR ."\"\n" .
+	       '->LEN "' .$sv->LEN ."\"\n" ;
+       },
+);
+
+testop($exe[8],
+       bcons => '9  <$> const[PV "B::Generate"] sM ',
+       name => 'const',
+       class => 'B::SVOP',
+       flags => &B::OPf_WANT_SCALAR | &B::OPf_MOD,
+       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");
+	   1;
+       },
+    );
+

Added: B-Generate/vendor/t/inspect-this.t
==============================================================================
--- (empty file)
+++ B-Generate/vendor/t/inspect-this.t	Fri May 16 03:12:26 2008
@@ -0,0 +1,41 @@
+#!perl
+
+use Test::More tests => 655;
+use_ok 'B';
+
+#use_ok 'B::Generate'; # cannot use here, due to clash with B::Concise
+
+use BTest;
+
+$i += $_ for 1..10;
+for (1..10) {
+    $i += $_;
+}
+
+my $j += $_ for 1..10;
+for my $i (1..10) {
+    $j += $i;
+}
+
+$j = "black" if $j;
+
+if ($i) {
+    $i = "eye";
+}
+
+$i =~ /bar/;
+$j =~ s/black/grey/;
+
+my $str = "the quick brown fox";
+
+$str =~ s/fox/bear/;
+
+
+sub Foo::bar { 1 }
+my $f = bless {}, 'Foo';
+
+$f->bar;
+
+
+test_self_ops( -v => scalar @ARGV );
+

Added: B-Generate/vendor/t/op_list.t
==============================================================================
--- (empty file)
+++ B-Generate/vendor/t/op_list.t	Fri May 16 03:12:26 2008
@@ -0,0 +1,28 @@
+#!perl
+use Test::More tests => 2;
+use_ok 'B';
+
+# B::Generate.pm comments say "MUST FIX CONSTANTS", 2x, with *emphasis*.
+# Whats more, OP_LIST value has changed over releases.
+# So we better test for it.
+
+# 1st test is baseline, not even using/testing B::Generate.  This
+# insures that we get failure reports until we get right
+# release-dependent values, which we reverify using B-Gen in 2nd test
+
+my %list_nums = (
+    145 => "5.011000",
+    142 => "5.010000",
+    141 => "5.008008",	# probably should be 5.008(00[12])?
+    );
+
+my $got = B::opnumber("list");
+my $vers = $list_nums{$got};
+
+if ($vers) {
+    # our opnum matches a known one, test that our version agrees
+    ok($] >= $list_nums{$got}, "B::opnumber('list') -> $got on $]");
+}
+else {
+    ok(0, "no ref data - please send this: B::opnumber('list') -> $got on $]");
+}

Added: B-Generate/vendor/t/op_list_bgen.t
==============================================================================
--- (empty file)
+++ B-Generate/vendor/t/op_list_bgen.t	Fri May 16 03:12:26 2008
@@ -0,0 +1,31 @@
+#!perl
+
+# B::Generate.pm comments say "MUST FIX CONSTANTS", 2x, with *emphasis*.
+# Whats more, OP_LIST value has changed over releases.
+# So we better test for it.
+
+# 1st test is baseline, not even using/testing B::Generate.  This
+# insures that we get failure reports until we get right
+# release-dependent values, which we reverify using B-Gen in 2nd test
+
+# 2nd test uses a constant declared inside B::Generate, which was
+# formerly hard-coded, but now calls B::opnumber().
+# The test is rather pedantic
+
+use Test::More tests => 4;
+use_ok 'B';
+use_ok 'B::Generate';
+
+my $ref = B::opnumber("list");
+my $check = &B::OP::OP_LIST;
+my $check2 = B::OP::OP_LIST();
+
+# the constness isnt seen w/o hints (&,())
+my $check3 = B::OP::OP_LIST;
+
+ok ($ref == $check, "B & B-Gen agree that OP_LIST == $ref");
+ok ($ref == $check2, "B & B-Gen agree that OP_LIST == $ref");
+
+
+__END__
+


More information about the Jifty-commit mailing list