diff -ruN -X exclude-diffs B-Generate-1.06-orig/Build.PL bgen-latest/Build.PL --- B-Generate-1.06-orig/Build.PL 2002-06-18 21:14:58.000000000 -0600 +++ bgen-latest/Build.PL 2005-08-20 10:17:16.000000000 -0600 @@ -16,12 +16,18 @@ } ); +my %newTweaks; +if ($] >= 5.008) { + %newTweaks = (extra_compiler_flags => '-DPERL_CUSTOM_OPS -DPERL_CUSTOM_OPCODES'); +} my $build = $class->new ( module_name => 'B::Generate', - license => 'unknown', + license => 'unknown', # Simon ? dynamic_config => 0, + requires => { perl => '5.5.62' }, + %newTweaks, ); $build->create_build_script; diff -ruN -X exclude-diffs B-Generate-1.06-orig/Changes bgen-latest/Changes --- B-Generate-1.06-orig/Changes 2002-07-28 10:44:27.000000000 -0600 +++ bgen-latest/Changes 2005-08-20 10:17:16.000000000 -0600 @@ -1,5 +1,14 @@ Revision history for Perl extension B::Generate. +1.06_01 Fri Nov 7 23:30:03 MST 2003 + changes to compile for 5.8.1+ by Jim Cromie + - altered Build.PL to add extra_compiler_flags when building for 5.8.x, + ie: -DPERL_CUSTOM_OPS -DPERL_CUSTOM_OPCODES + these didnt work for me under 5.6.x + - silenced redefined warnings with $SIG{__WARN__} + - various XS tweaks: casts, aTHX_, and Perl_ prefix on symbols + - various pm tweaks to silence warnings + 1.06 Sun Jul 28 18:43:06 CEST 2002 - Added support for changing PV in SvPV diff -ruN -X exclude-diffs B-Generate-1.06-orig/lib/B/Generate.pm bgen-latest/lib/B/Generate.pm --- B-Generate-1.06-orig/lib/B/Generate.pm 2002-07-02 06:39:09.000000000 -0600 +++ bgen-latest/lib/B/Generate.pm 2005-08-20 10:17:16.000000000 -0600 @@ -9,11 +9,16 @@ our @ISA = qw(DynaLoader); -our $VERSION = '1.06'; +our $VERSION = '1.06_01'; { -no warnings; -bootstrap B::Generate $VERSION; + # no warnings; # doesnt work. + # this does: L + local $SIG{__WARN__} = sub { + return if $_[0] =~ /Subroutine B(::\w+)+ redefined/; + warn $_[0]; + }; + bootstrap B::Generate $VERSION; } use constant OP_LIST => 141; # MUST FIX CONSTANTS. diff -ruN -X exclude-diffs B-Generate-1.06-orig/lib/B/Generate.xs bgen-latest/lib/B/Generate.xs --- B-Generate-1.06-orig/lib/B/Generate.xs 2002-07-28 10:45:48.000000000 -0600 +++ bgen-latest/lib/B/Generate.xs 2005-08-20 10:17:16.000000000 -0600 @@ -193,7 +193,11 @@ sv_setiv(newSVrv(arg, type), iv); return arg; } -#define PERL_CUSTOM_OPS + +/* + #define PERL_CUSTOM_OPS + now defined by Build.PL, if building for 5.8.x + */ static I32 op_name_to_num(SV * name) { @@ -460,7 +464,7 @@ OP_find_cv(o) B::OP o CODE: - RETVAL = SvRV(find_cv_by_root((OP*)o)); + RETVAL = (CV*) SvRV(find_cv_by_root((OP*)o)); OUTPUT: RETVAL @@ -641,8 +645,8 @@ o = CALL_FPTR(PL_check[type])(aTHX_ (OP*)o); - if (o->op_type == type) - o = fold_constants(o); + if (o->op_type == type) + o = (OP*) Perl_fold_constants(aTHX_ o); OUTPUT: o @@ -766,7 +770,7 @@ else { o = newBINOP(optype, flags, first, last); #ifdef PERL_CUSTOM_OPCODES - if (typenum == OP_CUSTOM) + if (optype == OP_CUSTOM) o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type)); #endif } diff -ruN -X exclude-diffs B-Generate-1.06-orig/test.pl bgen-latest/test.pl --- B-Generate-1.06-orig/test.pl 2002-07-28 10:49:27.000000000 -0600 +++ bgen-latest/test.pl 2005-08-20 10:17:16.000000000 -0600 @@ -3,69 +3,80 @@ use B qw(svref_2object); use B::Generate; $loaded = 1; -print "ok 1\n"; +print "ok 1 - B::Generate loaded\n"; BEGIN { # @B::NULL::ISA = 'B::OP'; } ######################### End of black magic. -CHECK{ +CHECK { + my ($x, $y, $z); - - my ($x, $y,$z); - $x = B::main_start; - for ($x = B::main_start; $x->type != B::opnumber("add"); $x=$x->next){ # Find "add" - $y=$x; # $y is the op before "add" + # Find "add" opcode in main: $a + $b + for ($x = B::main_start; + $x->type != B::opnumber("add"); + $x = $x->next) + { + $y = $x; # $y is the op before "add" }; - $z = new B::BINOP("subtract",0,$x->first, $x->last); # Create replacement "subtract" + # Create replacement "subtract" + $z = new B::BINOP("subtract", 0, $x->first, $x->last); $z->next($x->next); # Copy add's "next" across. $y->next($z); # Tell $y to point to replacement op. $z->targ($x->targ); my $i = 0; - for( - $x = B::main_start; - B::opnumber("const") != $x->type || $x->sv->sv != 30; - $x=$x->next){} + for ($x = B::main_start; + B::opnumber("const") ne $x->type || $x->sv->sv ne 30; + $x = $x->next) {} $x->sv(13); - for( - $x = svref_2object($foo)->START; - ref($x) ne 'B::NULL'; - $x = $x->next) { - next unless($x->can(sv)); - if($x->sv->PV eq "not ok 5\n") { - $x->sv("ok 5\n"); - last; - } - } +#} +#CHECK { +# my ($x, $y, $z); + - for( - $x = svref_2object(\&foo::baz)->START; - ref($x) ne 'B::NULL'; - $x = $x->next) { - next unless($x->can(sv)); + # find a sub, defd below, and fix it to pass + for ($x = svref_2object(\&foo::baz)->START; + ref($x) ne 'B::NULL'; + $x = $x->next) + { + next unless($x->can('sv')); if($x->sv->PV eq "not ok 6\n") { $x->sv("ok 6\n"); last; } } + # find the anonymous sub, defd in BEGIN block below, and fix it to pass + for ($x = svref_2object($foo)->START; + ref($x) ne 'B::NULL'; + $x = $x->next) + { + next unless($x->can('sv')); + if ($x->sv->PV eq "not ok 5\n") { + $x->sv("ok 5\n"); + last; + } + } } my $b; # STAY STILL! -$a = 17; $b = 15; print "ok ", $a + $b, "\n"; -$c = 30; $d = 10; print "ok ", $c - $d, "\n"; +$a = 17; $b = 15; +print "ok ", $a + $b, " - addition op subverted\n"; -my $newop = B::BINOP->new("add", 0, undef, undef); # This used to segv -print "ok 4\n"; +$c = 30; $d = 10; +print "ok ", $c - $d, " - altered 1st term in subtraction op\n"; + +# This used to segv with last args: undef, undef); +my $newop = B::BINOP->new("add", 0, 0, 0); +print "ok 4 - new opnode created\n"; BEGIN { -$foo = sub { - - print "not ok 5\n"; -} + $foo = sub { + print "not ok 5\n"; + } } $foo->(); foo::baz(); @@ -85,24 +96,27 @@ } } -{ - my $foo = "hi"; +{ # Test variable access, 8,9,10 + + my $foo = "hi"; # hide anonsub my $x = svref_2object(\$foo); - if($x->PV eq "hi") { - print "ok 8\n"; - } else { - print "not ok 8\n"; - } + + # test that it works like a variable + print(($x->PV eq "hi") ? "" : "not", "ok 8 - found lexical var\n"); + + # force a change via objref, and test for new val $x->PV("bar"); - if($x->PV eq "bar") { - print "ok 9\n"; - } else { - print "not ok 9\n"; - } - if($foo eq "bar") { - print "ok 10\n"; - } else { - print "not ok 10\n"; - } + print(($x->PV eq "bar") ? "" : "not", "ok 9 - altered via objref\n"); + + # test that change is reflected in original var + print(($foo eq "bar") ? "" : "not", "ok 10 - original has alteration\n"); } + +__END__ + +print "done: ", B::Concise::compile + ( \&foo::baz, + 'foo::baz', + $doit, + )->() if 10;