This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
document limitation of exec() inside pseudo-processes
[perl5.git] / ext / B / t / deparse.t
CommitLineData
87a42246
MS
1#!./perl
2
3BEGIN {
5638aaac
SM
4 if ($ENV{PERL_CORE}){
5 chdir('t') if -d 't';
6 if ($^O eq 'MacOS') {
7 @INC = qw(: ::lib ::macos:lib);
8 } else {
9 @INC = '.';
10 push @INC, '../lib';
11 }
87a42246 12 } else {
5638aaac 13 unshift @INC, 't';
87a42246 14 }
9cd8f857
NC
15 require Config;
16 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
17 print "1..0 # Skip -- Perl configured without B module\n";
18 exit 0;
19 }
87a42246
MS
20}
21
87a42246
MS
22use warnings;
23use strict;
09d856fb 24use Test::More tests => 50;
87a42246
MS
25
26use B::Deparse;
09d856fb
CK
27my $deparse = B::Deparse->new();
28ok($deparse);
87a42246
MS
29
30# Tell B::Deparse about our ambient pragmas
31{ my ($hint_bits, $warning_bits);
b891b733 32 BEGIN { ($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS}); }
87a42246
MS
33 $deparse->ambient_pragmas (
34 hint_bits => $hint_bits,
35 warning_bits => $warning_bits,
36 '$[' => 0 + $[
37 );
38}
39
ad46c0be
RH
40$/ = "\n####\n";
41while (<DATA>) {
42 chomp;
ec59cdf2
RGS
43 s/#\s*(.*)$//mg;
44 my ($num, $testname) = $1 =~ m/(\d+)\s*(.*)/;
ad46c0be
RH
45 my ($input, $expected);
46 if (/(.*)\n>>>>\n(.*)/s) {
47 ($input, $expected) = ($1, $2);
48 }
49 else {
50 ($input, $expected) = ($_, $_);
51 }
87a42246 52
ad46c0be 53 my $coderef = eval "sub {$input}";
87a42246 54
ad46c0be 55 if ($@) {
ec59cdf2
RGS
56 diag("$num deparsed: $@");
57 ok(0, $testname);
ad46c0be
RH
58 }
59 else {
60 my $deparsed = $deparse->coderef2text( $coderef );
31c6271a
RD
61 my $regex = $expected;
62 $regex =~ s/(\S+)/\Q$1/g;
63 $regex =~ s/\s+/\\s+/g;
64 $regex = '^\{\s*' . $regex . '\s*\}$';
ec59cdf2 65 like($deparsed, qr/$regex/, $testname);
87a42246 66 }
87a42246
MS
67}
68
87a42246 69use constant 'c', 'stuff';
09d856fb 70is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff');
87a42246 71
09d856fb
CK
72my $a = 0;
73is("{\n (-1) ** \$a;\n}", $deparse->coderef2text(sub{(-1) ** $a }));
87a42246 74
d989cdac
SM
75use constant cr => ['hello'];
76my $string = "sub " . $deparse->coderef2text(\&cr);
77my $val = (eval $string)->();
09d856fb 78ok( ref($val) eq 'ARRAY' && $val->[0] eq 'hello');
87a42246 79
87a42246
MS
80my $Is_VMS = $^O eq 'VMS';
81my $Is_MacOS = $^O eq 'MacOS';
82
83my $path = join " ", map { qq["-I$_"] } @INC;
be708cc0 84$path .= " -MMac::err=unix" if $Is_MacOS;
87a42246
MS
85my $redir = $Is_MacOS ? "" : "2>&1";
86
d2bc402e 87$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`;
e69a2255 88$a =~ s/-e syntax OK\n//g;
d2bc402e 89$a =~ s/.*possible typo.*\n//; # Remove warning line
87a42246
MS
90$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
91$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
92$b = <<'EOF';
d2bc402e
RGS
93BEGIN { $^I = ".bak"; }
94BEGIN { $^W = 1; }
95BEGIN { $/ = "\n"; $\ = "\n"; }
87a42246
MS
96LINE: while (defined($_ = <ARGV>)) {
97 chomp $_;
f86ea535 98 our(@F) = split(' ', $_, 0);
87a42246
MS
99 '???';
100}
87a42246 101EOF
e69a2255
JH
102$b =~ s/(LINE:)/sub BEGIN {
103 'MacPerl'->bootstrap;
104 'OSA'->bootstrap;
105 'XL'->bootstrap;
106}
107$1/ if $Is_MacOS;
09d856fb 108is($a, $b);
87a42246 109
579a54dc 110#Re: perlbug #35857, patch #24505
b3980c39
YO
111#handle warnings::register-ed packages properly.
112package B::Deparse::Wrapper;
113use strict;
114use warnings;
115use warnings::register;
116sub getcode {
579a54dc 117 my $deparser = B::Deparse->new();
b3980c39
YO
118 return $deparser->coderef2text(shift);
119}
120
121package main;
122use strict;
123use warnings;
124sub test {
579a54dc
RGS
125 my $val = shift;
126 my $res = B::Deparse::Wrapper::getcode($val);
09d856fb 127 like( $res, qr/use warnings/);
b3980c39
YO
128}
129my ($q,$p);
130my $x=sub { ++$q,++$p };
131test($x);
132eval <<EOFCODE and test($x);
133 package bar;
134 use strict;
135 use warnings;
136 use warnings::register;
137 package main;
138 1
139EOFCODE
140
ad46c0be 141__DATA__
14a55f98 142# 2
ad46c0be
RH
1431;
144####
14a55f98 145# 3
ad46c0be
RH
146{
147 no warnings;
148 '???';
149 2;
150}
151####
14a55f98 152# 4
ad46c0be
RH
153my $test;
154++$test and $test /= 2;
155>>>>
156my $test;
157$test /= 2 if ++$test;
158####
14a55f98 159# 5
ad46c0be
RH
160-((1, 2) x 2);
161####
14a55f98 162# 6
ad46c0be
RH
163{
164 my $test = sub : lvalue {
165 my $x;
166 }
167 ;
168}
169####
14a55f98 170# 7
ad46c0be
RH
171{
172 my $test = sub : method {
173 my $x;
174 }
175 ;
176}
177####
14a55f98 178# 8
ad46c0be
RH
179{
180 my $test = sub : locked method {
181 my $x;
182 }
183 ;
184}
185####
14a55f98 186# 9
87a42246 187{
ad46c0be 188 234;
f99a63a2 189}
ad46c0be
RH
190continue {
191 123;
87a42246 192}
ce4e655d 193####
14a55f98 194# 10
ce4e655d
RH
195my $x;
196print $main::x;
197####
14a55f98 198# 11
ce4e655d
RH
199my @x;
200print $main::x[1];
14a55f98
RH
201####
202# 12
203my %x;
204$x{warn()};
ad8caead
RGS
205####
206# 13
207my $foo;
208$_ .= <ARGV> . <$foo>;
cef22867
JH
209####
210# 14
211my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ";
4ae52e81
RGS
212####
213# 15
214s/x/'y';/e;
241416b8
DM
215####
216# 16 - various lypes of loop
217{ my $x; }
218####
219# 17
220while (1) { my $k; }
221####
222# 18
223my ($x,@a);
224$x=1 for @a;
225>>>>
226my($x, @a);
0bb5f065 227$x = 1 foreach (@a);
241416b8
DM
228####
229# 19
230for (my $i = 0; $i < 2;) {
231 my $z = 1;
232}
233####
234# 20
235for (my $i = 0; $i < 2; ++$i) {
236 my $z = 1;
237}
238####
239# 21
240for (my $i = 0; $i < 2; ++$i) {
241 my $z = 1;
242}
243####
244# 22
245my $i;
246while ($i) { my $z = 1; } continue { $i = 99; }
247####
248# 23
09d856fb 249foreach my $i (1, 2) {
241416b8
DM
250 my $z = 1;
251}
252####
253# 24
254my $i;
255foreach $i (1, 2) {
256 my $z = 1;
257}
258####
259# 25
260my $i;
261foreach my $i (1, 2) {
262 my $z = 1;
263}
264####
265# 26
266foreach my $i (1, 2) {
267 my $z = 1;
268}
269####
270# 27
271foreach our $i (1, 2) {
272 my $z = 1;
273}
274####
275# 28
276my $i;
277foreach our $i (1, 2) {
278 my $z = 1;
279}
3ac6e0f9
RGS
280####
281# 29
282my @x;
283print reverse sort(@x);
284####
285# 30
286my @x;
287print((sort {$b cmp $a} @x));
288####
289# 31
290my @x;
291print((reverse sort {$b <=> $a} @x));
36d57d93
RGS
292####
293# 32
294our @a;
295print $_ foreach (reverse @a);
aae53c41 296####
579a54dc 297# 33
aae53c41
RGS
298our @a;
299print $_ foreach (reverse 1, 2..5);
f86ea535
SM
300####
301# 34 (bug #38684)
302our @ary;
303@ary = split(' ', 'foo', 0);
31c6271a
RD
304####
305# 35 (bug #40055)
306do { () };
307####
308# 36 (ibid.)
309do { my $x = 1; $x };
d9002312
SM
310####
311# 37 <20061012113037.GJ25805@c4.convolution.nl>
312my $f = sub {
313 +{[]};
314} ;
8b2d6640
FC
315####
316# 38 (bug #43010)
317'!@$%'->();
318####
319# 39 (ibid.)
320::();
321####
322# 40 (ibid.)
323'::::'->();
324####
325# 41 (ibid.)
326&::::;
09d856fb
CK
327####
328# 42
329my $bar;
330'Foo'->$bar('orz');
331####
332# 43
333'Foo'->bar('orz');
334####
335# 44
336'Foo'->bar;