This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #30504] B::Deparse scoping problem with for loop
[perl5.git] / ext / B / t / deparse.t
CommitLineData
87a42246
MS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 if ($^O eq 'MacOS') {
6 @INC = qw(: ::lib ::macos:lib);
7 } else {
8 @INC = '.';
9 push @INC, '../lib';
10 }
9cd8f857
NC
11 require Config;
12 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13 print "1..0 # Skip -- Perl configured without B module\n";
14 exit 0;
15 }
87a42246
MS
16}
17
18$| = 1;
19use warnings;
20use strict;
21use Config;
22
d989cdac 23print "1..32\n";
87a42246
MS
24
25use B::Deparse;
26my $deparse = B::Deparse->new() or print "not ";
ad46c0be 27my $i=1;
d4a0c6f3 28print "ok " . $i++ . "\n";
ad46c0be 29
87a42246
MS
30
31# Tell B::Deparse about our ambient pragmas
32{ my ($hint_bits, $warning_bits);
b891b733 33 BEGIN { ($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS}); }
87a42246
MS
34 $deparse->ambient_pragmas (
35 hint_bits => $hint_bits,
36 warning_bits => $warning_bits,
37 '$[' => 0 + $[
38 );
39}
40
ad46c0be
RH
41$/ = "\n####\n";
42while (<DATA>) {
43 chomp;
44 s/#.*$//mg;
87a42246 45
ad46c0be
RH
46 my ($input, $expected);
47 if (/(.*)\n>>>>\n(.*)/s) {
48 ($input, $expected) = ($1, $2);
49 }
50 else {
51 ($input, $expected) = ($_, $_);
52 }
87a42246 53
ad46c0be 54 my $coderef = eval "sub {$input}";
87a42246 55
ad46c0be 56 if ($@) {
d4a0c6f3 57 print "not ok " . $i++ . "\n";
ad46c0be
RH
58 print "# $@";
59 }
60 else {
61 my $deparsed = $deparse->coderef2text( $coderef );
62 my $regex = quotemeta($expected);
63 do {
64 no warnings 'misc';
65 $regex =~ s/\s+/\s+/g;
66 };
67
68 my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/);
d4a0c6f3 69 print (($ok ? "ok " : "not ok ") . $i++ . "\n");
ad46c0be
RH
70 if (!$ok) {
71 print "# EXPECTED:\n";
72 $regex =~ s/^/# /mg;
73 print "$regex\n";
74
75 print "\n# GOT: \n";
76 $deparsed =~ s/^/# /mg;
77 print "$deparsed\n";
78 }
87a42246 79 }
87a42246
MS
80}
81
87a42246
MS
82use constant 'c', 'stuff';
83print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
d4a0c6f3 84print "ok " . $i++ . "\n";
87a42246
MS
85
86$a = 0;
87print "not " if "{\n (-1) ** \$a;\n}"
88 ne $deparse->coderef2text(sub{(-1) ** $a });
d4a0c6f3 89print "ok " . $i++ . "\n";
87a42246 90
d989cdac
SM
91use constant cr => ['hello'];
92my $string = "sub " . $deparse->coderef2text(\&cr);
93my $val = (eval $string)->();
94print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
95print "ok " . $i++ . "\n";
87a42246
MS
96
97my $a;
98my $Is_VMS = $^O eq 'VMS';
99my $Is_MacOS = $^O eq 'MacOS';
100
101my $path = join " ", map { qq["-I$_"] } @INC;
be708cc0 102$path .= " -MMac::err=unix" if $Is_MacOS;
87a42246
MS
103my $redir = $Is_MacOS ? "" : "2>&1";
104
d2bc402e 105$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`;
e69a2255 106$a =~ s/-e syntax OK\n//g;
d2bc402e 107$a =~ s/.*possible typo.*\n//; # Remove warning line
87a42246
MS
108$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
109$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
110$b = <<'EOF';
d2bc402e
RGS
111BEGIN { $^I = ".bak"; }
112BEGIN { $^W = 1; }
113BEGIN { $/ = "\n"; $\ = "\n"; }
87a42246
MS
114LINE: while (defined($_ = <ARGV>)) {
115 chomp $_;
14a55f98 116 our(@F) = split(" ", $_, 0);
87a42246
MS
117 '???';
118}
87a42246 119EOF
e69a2255
JH
120$b =~ s/(LINE:)/sub BEGIN {
121 'MacPerl'->bootstrap;
122 'OSA'->bootstrap;
123 'XL'->bootstrap;
124}
125$1/ if $Is_MacOS;
7204222c 126print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b;
d4a0c6f3 127print "ok " . $i++ . "\n";
87a42246 128
ad46c0be 129__DATA__
14a55f98 130# 2
ad46c0be
RH
1311;
132####
14a55f98 133# 3
ad46c0be
RH
134{
135 no warnings;
136 '???';
137 2;
138}
139####
14a55f98 140# 4
ad46c0be
RH
141my $test;
142++$test and $test /= 2;
143>>>>
144my $test;
145$test /= 2 if ++$test;
146####
14a55f98 147# 5
ad46c0be
RH
148-((1, 2) x 2);
149####
14a55f98 150# 6
ad46c0be
RH
151{
152 my $test = sub : lvalue {
153 my $x;
154 }
155 ;
156}
157####
14a55f98 158# 7
ad46c0be
RH
159{
160 my $test = sub : method {
161 my $x;
162 }
163 ;
164}
165####
14a55f98 166# 8
ad46c0be
RH
167{
168 my $test = sub : locked method {
169 my $x;
170 }
171 ;
172}
173####
14a55f98 174# 9
87a42246 175{
ad46c0be 176 234;
f99a63a2 177}
ad46c0be
RH
178continue {
179 123;
87a42246 180}
ce4e655d 181####
14a55f98 182# 10
ce4e655d
RH
183my $x;
184print $main::x;
185####
14a55f98 186# 11
ce4e655d
RH
187my @x;
188print $main::x[1];
14a55f98
RH
189####
190# 12
191my %x;
192$x{warn()};
ad8caead
RGS
193####
194# 13
195my $foo;
196$_ .= <ARGV> . <$foo>;
cef22867
JH
197####
198# 14
199my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ";
4ae52e81
RGS
200####
201# 15
202s/x/'y';/e;
241416b8
DM
203####
204# 16 - various lypes of loop
205{ my $x; }
206####
207# 17
208while (1) { my $k; }
209####
210# 18
211my ($x,@a);
212$x=1 for @a;
213>>>>
214my($x, @a);
215foreach $_ (@a) {
216 $x = 1;
217}
218####
219# 19
220for (my $i = 0; $i < 2;) {
221 my $z = 1;
222}
223####
224# 20
225for (my $i = 0; $i < 2; ++$i) {
226 my $z = 1;
227}
228####
229# 21
230for (my $i = 0; $i < 2; ++$i) {
231 my $z = 1;
232}
233####
234# 22
235my $i;
236while ($i) { my $z = 1; } continue { $i = 99; }
237####
238# 23
239foreach $i (1, 2) {
240 my $z = 1;
241}
242####
243# 24
244my $i;
245foreach $i (1, 2) {
246 my $z = 1;
247}
248####
249# 25
250my $i;
251foreach my $i (1, 2) {
252 my $z = 1;
253}
254####
255# 26
256foreach my $i (1, 2) {
257 my $z = 1;
258}
259####
260# 27
261foreach our $i (1, 2) {
262 my $z = 1;
263}
264####
265# 28
266my $i;
267foreach our $i (1, 2) {
268 my $z = 1;
269}