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