This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
s/PERL_COPY_ON_WRITE/PERL_OLD_COPY_ON_WRITE/g
[perl5.git] / ext / B / t / bytecode.t
CommitLineData
46983aad 1#!./perl
58d73325
JH
2my $keep_plc = 0; # set it to keep the bytecode files
3my $keep_plc_fail = 1; # set it to keep the bytecode files on failures
46983aad
AE
4
5BEGIN {
ba566e15
JH
6 if ($^O eq 'VMS') {
7 print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n";
8 exit 0;
9 }
5638aaac
SM
10 if ($ENV{PERL_CORE}){
11 chdir('t') if -d 't';
12 @INC = ('.', '../lib');
13 } else {
14 unshift @INC, 't';
15 push @INC, "../../t";
16 }
a243a48e 17 use Config;
9cd8f857
NC
18 if (($Config{'extensions'} !~ /\bB\b/) ){
19 print "1..0 # Skip -- Perl configured without B module\n";
20 exit 0;
21 }
f8c7b90f 22 if ($Config{ccflags} =~ /-DPERL_OLD_COPY_ON_WRITE/) {
a243a48e
JH
23 print "1..0 # skip - no COW for now\n";
24 exit 0;
25 }
5638aaac 26 require 'test.pl'; # for run_perl()
46983aad
AE
27}
28use strict;
29
46983aad
AE
30undef $/;
31my @tests = split /\n###+\n/, <DATA>;
32
33print "1..".($#tests+1)."\n";
34
35my $cnt = 1;
58d73325 36my $test;
46983aad
AE
37
38for (@tests) {
39 my $got;
40 my ($script, $expect) = split />>>+\n/;
41 $expect =~ s/\n$//;
58d73325 42 $test = "bytecode$cnt.pl";
46983aad 43 open T, ">$test"; print T $script; close T;
ba566e15
JH
44 $got = run_perl(switches => [ "-MO=Bytecode,-H,-o${test}c" ],
45 verbose => 0, # for debugging
46 stderr => 1, # to capture the "bytecode.pl syntax ok"
46983aad
AE
47 progfile => $test);
48 unless ($?) {
ba566e15 49 $got = run_perl(progfile => "${test}c"); # run the .plc
46983aad
AE
50 unless ($?) {
51 if ($got =~ /^$expect$/) {
52 print "ok $cnt\n";
53 next;
54 } else {
58d73325 55 $keep_plc = $keep_plc_fail unless $keep_plc;
46983aad
AE
56 print <<"EOT"; next;
57not ok $cnt
58--------- SCRIPT
59$script
60--------- GOT
61$got
62--------- EXPECT
63$expect
64----------------
65
66EOT
67 }
68 }
69 }
70 print <<"EOT";
71--------- SCRIPT
72$script
73--------- $?
74$got
75EOT
76} continue {
58d73325 77 1 while unlink($test, $keep_plc ? () : "${test}c");
46983aad
AE
78 $cnt++;
79}
80
81__DATA__
82
83print 'hi'
84>>>>
85hi
86############################################################
87for (1,2,3) { print if /\d/ }
88>>>>
89123
90############################################################
91$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
92>>>>
93zzz2y2y2
94############################################################
95$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
96>>>>
97z2y2y2
98############################################################
99split /a/,"bananarama"; print @_
100>>>>
101bnnrm
102############################################################
103{ package P; sub x { print 'ya' } x }
104>>>>
105ya
106############################################################
107@z = split /:/,"b:r:n:f:g"; print @z
108>>>>
109brnfg
110############################################################
111sub AUTOLOAD { print 1 } &{"a"}()
112>>>>
1131
114############################################################
115my $l = 3; $x = sub { print $l }; &$x
116>>>>
1173
118############################################################
119my $i = 1;
120my $foo = sub {$i = shift if @_};
121&$foo(3);
5638aaac
SM
122print 'ok';
123>>>>
124ok
46983aad 125############################################################
46983aad
AE
126$x="Cannot use"; print index $x, "Can"
127>>>>
1280
129############################################################
130my $i=6; eval "print \$i\n"
131>>>>
1326
133############################################################
134BEGIN { %h=(1=>2,3=>4) } print $h{3}
135>>>>
1364
137############################################################
5638aaac
SM
138open our $T,"a";
139print 'ok';
140>>>>
141ok
46983aad
AE
142############################################################
143print <DATA>
144__DATA__
145a
146b
147>>>>
148a
149b
150############################################################
151BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
152print $a[1]
153>>>>
1541
155############################################################
156my $i=3; print 1 .. $i
157>>>>
158123
159############################################################
160my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
161>>>>
162ba
163############################################################
164print sort { my $p; $b <=> $a } 1,4,3
165>>>>
166431