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
18print "1..32\n";
19
20use B::Deparse;
21my $deparse = B::Deparse->new() or print "not ";
22my $i=1;
23print "ok " . $i++ . "\n";
24
25
26# Tell B::Deparse about our ambient pragmas
27{ my ($hint_bits, $warning_bits);
28 BEGIN { ($hint_bits, $warning_bits) = ($^H, ${^WARNING_BITS}); }
29 $deparse->ambient_pragmas (
30     hint_bits    => $hint_bits,
31     warning_bits => $warning_bits,
32     '$['         => 0 + $[
33 );
34}
35
36$/ = "\n####\n";
37while (<DATA>) {
38    chomp;
39    s/#.*$//mg;
40
41    my ($input, $expected);
42    if (/(.*)\n>>>>\n(.*)/s) {
43	($input, $expected) = ($1, $2);
44    }
45    else {
46	($input, $expected) = ($_, $_);
47    }
48
49    my $coderef = eval "sub {$input}";
50
51    if ($@) {
52	print "not ok " . $i++ . "\n";
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*\}$/);
64	print (($ok ? "ok " : "not ok ") . $i++ . "\n");
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	}
74    }
75}
76
77use constant 'c', 'stuff';
78print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff';
79print "ok " . $i++ . "\n";
80
81$a = 0;
82print "not " if "{\n    (-1) ** \$a;\n}"
83		ne $deparse->coderef2text(sub{(-1) ** $a });
84print "ok " . $i++ . "\n";
85
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";
91
92my $a;
93my $Is_VMS = $^O eq 'VMS';
94my $Is_MacOS = $^O eq 'MacOS';
95
96my $path = join " ", map { qq["-I$_"] } @INC;
97$path .= " -MMac::err=unix" if $Is_MacOS;
98my $redir = $Is_MacOS ? "" : "2>&1";
99
100$a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`;
101$a =~ s/-e syntax OK\n//g;
102$a =~ s/.*possible typo.*\n//;	   # Remove warning line
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';
106BEGIN { $^I = ".bak"; }
107BEGIN { $^W = 1; }
108BEGIN { $/ = "\n"; $\ = "\n"; }
109LINE: while (defined($_ = <ARGV>)) {
110    chomp $_;
111    our(@F) = split(" ", $_, 0);
112    '???';
113}
114EOF
115$b =~ s/(LINE:)/sub BEGIN {
116    'MacPerl'->bootstrap;
117    'OSA'->bootstrap;
118    'XL'->bootstrap;
119}
120$1/ if $Is_MacOS;
121print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b;
122print "ok " . $i++ . "\n";
123
124__DATA__
125# 2
1261;
127####
128# 3
129{
130    no warnings;
131    '???';
132    2;
133}
134####
135# 4
136my $test;
137++$test and $test /= 2;
138>>>>
139my $test;
140$test /= 2 if ++$test;
141####
142# 5
143-((1, 2) x 2);
144####
145# 6
146{
147    my $test = sub : lvalue {
148	my $x;
149    }
150    ;
151}
152####
153# 7
154{
155    my $test = sub : method {
156	my $x;
157    }
158    ;
159}
160####
161# 8
162{
163    my $test = sub : locked method {
164	my $x;
165    }
166    ;
167}
168####
169# 9
170{
171    234;
172}
173continue {
174    123;
175}
176####
177# 10
178my $x;
179print $main::x;
180####
181# 11
182my @x;
183print $main::x[1];
184####
185# 12
186my %x;
187$x{warn()};
188####
189# 13
190my $foo;
191$_ .= <ARGV> . <$foo>;
192####
193# 14
194my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ";
195####
196# 15
197s/x/'y';/e;
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}
265