This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Benchmark nit from Nicholas Clark (in OpenBSD the result could
[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
4ae52e81 18print "1..18\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
MS
85
86# XXX ToDo - constsub that returns a reference
87#use constant cr => ['hello'];
88#my $string = "sub " . $deparse->coderef2text(\&cr);
89#my $val = (eval $string)->();
90#print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello';
d4a0c6f3 91#print "ok " . $i++ . "\n";
87a42246
MS
92
93my $a;
94my $Is_VMS = $^O eq 'VMS';
95my $Is_MacOS = $^O eq 'MacOS';
96
97my $path = join " ", map { qq["-I$_"] } @INC;
be708cc0 98$path .= " -MMac::err=unix" if $Is_MacOS;
87a42246
MS
99my $redir = $Is_MacOS ? "" : "2>&1";
100
d2bc402e 101$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`;
e69a2255 102$a =~ s/-e syntax OK\n//g;
d2bc402e 103$a =~ s/.*possible typo.*\n//; # Remove warning line
87a42246
MS
104$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
105$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
106$b = <<'EOF';
d2bc402e
RGS
107BEGIN { $^I = ".bak"; }
108BEGIN { $^W = 1; }
109BEGIN { $/ = "\n"; $\ = "\n"; }
87a42246
MS
110LINE: while (defined($_ = <ARGV>)) {
111 chomp $_;
14a55f98 112 our(@F) = split(" ", $_, 0);
87a42246
MS
113 '???';
114}
87a42246 115EOF
e69a2255
JH
116$b =~ s/(LINE:)/sub BEGIN {
117 'MacPerl'->bootstrap;
118 'OSA'->bootstrap;
119 'XL'->bootstrap;
120}
121$1/ if $Is_MacOS;
790ba596
JH
122if ($a ne $b) {
123 # A temporary debugging aid (Tru64 threaded smoke test somehow
124 # broke between 19150 and 19160, but works okay from command line.)
125 print STDERR "# [$a]\n\# vs expected\n# [$b]\n";
126 print "not ";
127}
d4a0c6f3 128print "ok " . $i++ . "\n";
87a42246 129
ad46c0be 130__DATA__
14a55f98 131# 2
ad46c0be
RH
1321;
133####
14a55f98 134# 3
ad46c0be
RH
135{
136 no warnings;
137 '???';
138 2;
139}
140####
14a55f98 141# 4
ad46c0be
RH
142my $test;
143++$test and $test /= 2;
144>>>>
145my $test;
146$test /= 2 if ++$test;
147####
14a55f98 148# 5
ad46c0be
RH
149-((1, 2) x 2);
150####
14a55f98 151# 6
ad46c0be
RH
152{
153 my $test = sub : lvalue {
154 my $x;
155 }
156 ;
157}
158####
14a55f98 159# 7
ad46c0be
RH
160{
161 my $test = sub : method {
162 my $x;
163 }
164 ;
165}
166####
14a55f98 167# 8
ad46c0be
RH
168{
169 my $test = sub : locked method {
170 my $x;
171 }
172 ;
173}
174####
14a55f98 175# 9
87a42246 176{
ad46c0be 177 234;
f99a63a2 178}
ad46c0be
RH
179continue {
180 123;
87a42246 181}
ce4e655d 182####
14a55f98 183# 10
ce4e655d
RH
184my $x;
185print $main::x;
186####
14a55f98 187# 11
ce4e655d
RH
188my @x;
189print $main::x[1];
14a55f98
RH
190####
191# 12
192my %x;
193$x{warn()};
ad8caead
RGS
194####
195# 13
196my $foo;
197$_ .= <ARGV> . <$foo>;
cef22867
JH
198####
199# 14
200my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ";
4ae52e81
RGS
201####
202# 15
203s/x/'y';/e;