Commit | Line | Data |
46983aad |
1 | #!./perl |
58d73325 |
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 |
46983aad |
4 | |
5 | BEGIN { |
ba566e15 |
6 | if ($^O eq 'VMS') { |
7 | print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n"; |
8 | exit 0; |
9 | } |
5638aaac |
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 |
18 | if (($Config{'extensions'} !~ /\bB\b/) ){ |
19 | print "1..0 # Skip -- Perl configured without B module\n"; |
20 | exit 0; |
21 | } |
a243a48e |
22 | if ($Config{ccflags} =~ /-DPERL_COPY_ON_WRITE/) { |
23 | print "1..0 # skip - no COW for now\n"; |
24 | exit 0; |
25 | } |
5638aaac |
26 | require 'test.pl'; # for run_perl() |
46983aad |
27 | } |
28 | use strict; |
29 | |
46983aad |
30 | undef $/; |
31 | my @tests = split /\n###+\n/, <DATA>; |
32 | |
33 | print "1..".($#tests+1)."\n"; |
34 | |
35 | my $cnt = 1; |
58d73325 |
36 | my $test; |
46983aad |
37 | |
38 | for (@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 |
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 |
47 | progfile => $test); |
48 | unless ($?) { |
ba566e15 |
49 | $got = run_perl(progfile => "${test}c"); # run the .plc |
46983aad |
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 |
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 | --------- SCRIPT |
72 | $script |
73 | --------- $? |
74 | $got |
75 | EOT |
76 | } continue { |
58d73325 |
77 | 1 while unlink($test, $keep_plc ? () : "${test}c"); |
46983aad |
78 | $cnt++; |
79 | } |
80 | |
81 | __DATA__ |
82 | |
83 | print 'hi' |
84 | >>>> |
85 | hi |
86 | ############################################################ |
87 | for (1,2,3) { print if /\d/ } |
88 | >>>> |
89 | 123 |
90 | ############################################################ |
91 | $_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_ |
92 | >>>> |
93 | zzz2y2y2 |
94 | ############################################################ |
95 | $_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_ |
96 | >>>> |
97 | z2y2y2 |
98 | ############################################################ |
99 | split /a/,"bananarama"; print @_ |
100 | >>>> |
101 | bnnrm |
102 | ############################################################ |
103 | { package P; sub x { print 'ya' } x } |
104 | >>>> |
105 | ya |
106 | ############################################################ |
107 | @z = split /:/,"b:r:n:f:g"; print @z |
108 | >>>> |
109 | brnfg |
110 | ############################################################ |
111 | sub AUTOLOAD { print 1 } &{"a"}() |
112 | >>>> |
113 | 1 |
114 | ############################################################ |
115 | my $l = 3; $x = sub { print $l }; &$x |
116 | >>>> |
117 | 3 |
118 | ############################################################ |
119 | my $i = 1; |
120 | my $foo = sub {$i = shift if @_}; |
121 | &$foo(3); |
5638aaac |
122 | print 'ok'; |
123 | >>>> |
124 | ok |
46983aad |
125 | ############################################################ |
46983aad |
126 | $x="Cannot use"; print index $x, "Can" |
127 | >>>> |
128 | 0 |
129 | ############################################################ |
130 | my $i=6; eval "print \$i\n" |
131 | >>>> |
132 | 6 |
133 | ############################################################ |
134 | BEGIN { %h=(1=>2,3=>4) } print $h{3} |
135 | >>>> |
136 | 4 |
137 | ############################################################ |
5638aaac |
138 | open our $T,"a"; |
139 | print 'ok'; |
140 | >>>> |
141 | ok |
46983aad |
142 | ############################################################ |
143 | print <DATA> |
144 | __DATA__ |
145 | a |
146 | b |
147 | >>>> |
148 | a |
149 | b |
150 | ############################################################ |
151 | BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } } |
152 | print $a[1] |
153 | >>>> |
154 | 1 |
155 | ############################################################ |
156 | my $i=3; print 1 .. $i |
157 | >>>> |
158 | 123 |
159 | ############################################################ |
160 | my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h |
161 | >>>> |
162 | ba |
163 | ############################################################ |
164 | print sort { my $p; $b <=> $a } 1,4,3 |
165 | >>>> |
166 | 431 |