[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