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