aelemfast optimization opclass problem (c.f. [perl #38279])

[p5sagit/p5-mst-13.2.git] / ext / B / t / bytecode.t

diff --git a/ext/B/t/bytecode.t b/ext/B/t/bytecode.t
index 75fcf2e..3c7d282 100644 (file)
--- a/ext/B/t/bytecode.t
+++ b/ext/B/t/bytecode.t
@@ -1,36 +1,58 @@
 #!./perl
+my $keep_plc      = 0; # set it to keep the bytecode files
+my $keep_plc_fail = 1; # set it to keep the bytecode files on failures
 
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = qw(../lib);
-    require './test.pl'; # for run_perl()
+    if ($^O eq 'VMS') {
+       print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n";
+       exit 0;
+    }
+    if ($ENV{PERL_CORE}){
+       chdir('t') if -d 't';
+       @INC = ('.', '../lib');
+    } else {
+       unshift @INC, 't';
+       push @INC, "../../t";
+    }
+    use Config;
+    if (($Config{'extensions'} !~ /\bB\b/) ){
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+    if ($Config{ccflags} =~ /-DPERL_OLD_COPY_ON_WRITE/) {
+       print "1..0 # skip - no COW for now\n";
+       exit 0;
+    }
+    require 'test.pl'; # for run_perl()
 }
 use strict;
 
-my $test = 'bytecode.pl';
-END { 1 while unlink $test }
-
 undef $/;
 my @tests = split /\n###+\n/, <DATA>;
 
 print "1..".($#tests+1)."\n";
 
 my $cnt = 1;
+my $test;
 
 for (@tests) {
     my $got;
     my ($script, $expect) = split />>>+\n/;
     $expect =~ s/\n$//;
+    $test = "bytecode$cnt.pl";
     open T, ">$test"; print T $script; close T;
-    $got = run_perl(switches => "-MO=Bytecode,-H,-o$test",
+    $got = run_perl(switches => [ "-MO=Bytecode,-H,-o${test}c" ],
+                   verbose  => 0, # for debugging
+                   stderr   => 1, # to capture the "bytecode.pl syntax ok"
                    progfile => $test);
     unless ($?) {
-       $got = run_perl(progfile => $test);
+       $got = run_perl(progfile => "${test}c"); # run the .plc
        unless ($?) {
            if ($got =~ /^$expect$/) {
                print "ok $cnt\n";
                next;
            } else {
+               $keep_plc = $keep_plc_fail unless $keep_plc;
                print <<"EOT"; next;
 not ok $cnt
 --------- SCRIPT
@@ -46,12 +68,14 @@ EOT
        }
     }
     print <<"EOT";
+not ok $cnt
 --------- SCRIPT
 $script
---------- $?
+--------- \$\? = $?
 $got
 EOT
 } continue {
+    1 while unlink($test, $keep_plc ? () : "${test}c");
     $cnt++;
 }
 
@@ -96,10 +120,9 @@ my $l = 3; $x = sub { print $l }; &$x
 my $i = 1;
 my $foo = sub {$i = shift if @_};
 &$foo(3);
-############################################################
-$_="\xff\xff"; use utf8; utf8::encode $_; print $_
+print 'ok';
 >>>>
-\xc3\xbf\xc3\xbf
+ok
 ############################################################
 $x="Cannot use"; print index $x, "Can"
 >>>>
@@ -113,7 +136,10 @@ BEGIN { %h=(1=>2,3=>4) } print $h{3}
 >>>>
 4
 ############################################################
-open our $T,"a"
+open our $T,"a";
+print 'ok';
+>>>>
+ok
 ############################################################
 print <DATA>
 __DATA__