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