This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
D'oh. Don't turn on warnings on the #! line without actually testing
[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 }
46983aad
AE
10 chdir 't' if -d 't';
11 @INC = qw(../lib);
a243a48e
JH
12 use Config;
13 if ($Config{ccflags} =~ /-DPERL_COPY_ON_WRITE/) {
14 print "1..0 # skip - no COW for now\n";
15 exit 0;
16 }
46983aad
AE
17 require './test.pl'; # for run_perl()
18}
19use strict;
20
46983aad
AE
21undef $/;
22my @tests = split /\n###+\n/, <DATA>;
23
24print "1..".($#tests+1)."\n";
25
26my $cnt = 1;
58d73325 27my $test;
46983aad
AE
28
29for (@tests) {
30 my $got;
31 my ($script, $expect) = split />>>+\n/;
32 $expect =~ s/\n$//;
58d73325 33 $test = "bytecode$cnt.pl";
46983aad 34 open T, ">$test"; print T $script; close T;
ba566e15
JH
35 $got = run_perl(switches => [ "-MO=Bytecode,-H,-o${test}c" ],
36 verbose => 0, # for debugging
37 stderr => 1, # to capture the "bytecode.pl syntax ok"
46983aad
AE
38 progfile => $test);
39 unless ($?) {
ba566e15 40 $got = run_perl(progfile => "${test}c"); # run the .plc
46983aad
AE
41 unless ($?) {
42 if ($got =~ /^$expect$/) {
43 print "ok $cnt\n";
44 next;
45 } else {
58d73325 46 $keep_plc = $keep_plc_fail unless $keep_plc;
46983aad
AE
47 print <<"EOT"; next;
48not ok $cnt
49--------- SCRIPT
50$script
51--------- GOT
52$got
53--------- EXPECT
54$expect
55----------------
56
57EOT
58 }
59 }
60 }
61 print <<"EOT";
62--------- SCRIPT
63$script
64--------- $?
65$got
66EOT
67} continue {
58d73325 68 1 while unlink($test, $keep_plc ? () : "${test}c");
46983aad
AE
69 $cnt++;
70}
71
72__DATA__
73
74print 'hi'
75>>>>
76hi
77############################################################
78for (1,2,3) { print if /\d/ }
79>>>>
80123
81############################################################
82$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
83>>>>
84zzz2y2y2
85############################################################
86$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
87>>>>
88z2y2y2
89############################################################
90split /a/,"bananarama"; print @_
91>>>>
92bnnrm
93############################################################
94{ package P; sub x { print 'ya' } x }
95>>>>
96ya
97############################################################
98@z = split /:/,"b:r:n:f:g"; print @z
99>>>>
100brnfg
101############################################################
102sub AUTOLOAD { print 1 } &{"a"}()
103>>>>
1041
105############################################################
106my $l = 3; $x = sub { print $l }; &$x
107>>>>
1083
109############################################################
110my $i = 1;
111my $foo = sub {$i = shift if @_};
112&$foo(3);
113############################################################
46983aad
AE
114$x="Cannot use"; print index $x, "Can"
115>>>>
1160
117############################################################
118my $i=6; eval "print \$i\n"
119>>>>
1206
121############################################################
122BEGIN { %h=(1=>2,3=>4) } print $h{3}
123>>>>
1244
125############################################################
126open our $T,"a"
127############################################################
128print <DATA>
129__DATA__
130a
131b
132>>>>
133a
134b
135############################################################
136BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
137print $a[1]
138>>>>
1391
140############################################################
141my $i=3; print 1 .. $i
142>>>>
143123
144############################################################
145my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
146>>>>
147ba
148############################################################
149print sort { my $p; $b <=> $a } 1,4,3
150>>>>
151431