Commit | Line | Data |
87a42246 |
1 | #!./perl |
2 | |
3 | BEGIN { |
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; |
14 | use warnings; |
15 | use strict; |
16 | use Config; |
17 | |
4ae52e81 |
18 | print "1..18\n"; |
87a42246 |
19 | |
20 | use B::Deparse; |
21 | my $deparse = B::Deparse->new() or print "not "; |
ad46c0be |
22 | my $i=1; |
d4a0c6f3 |
23 | print "ok " . $i++ . "\n"; |
ad46c0be |
24 | |
87a42246 |
25 | |
26 | # Tell B::Deparse about our ambient pragmas |
27 | { my ($hint_bits, $warning_bits); |
8fa7688f |
28 | # Note: there used to be ${^WARNING_BITS} here, instead of |
29 | # warnings::bits('all'), but this doesn't work, as ${^WARNING_BITS} is |
30 | # supposed to be the set of warnings this code has been compiled with, and |
31 | # later in this test we include modules that themselves use warnings::register |
32 | # (thus modyfing the warnings mask). |
33 | BEGIN { ($hint_bits, $warning_bits) = ($^H, warnings::bits('all')); } |
87a42246 |
34 | $deparse->ambient_pragmas ( |
35 | hint_bits => $hint_bits, |
36 | warning_bits => $warning_bits, |
37 | '$[' => 0 + $[ |
38 | ); |
39 | } |
40 | |
ad46c0be |
41 | $/ = "\n####\n"; |
42 | while (<DATA>) { |
43 | chomp; |
44 | s/#.*$//mg; |
87a42246 |
45 | |
ad46c0be |
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 |
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 |
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 |
80 | } |
81 | |
87a42246 |
82 | use constant 'c', 'stuff'; |
83 | print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff'; |
d4a0c6f3 |
84 | print "ok " . $i++ . "\n"; |
87a42246 |
85 | |
86 | $a = 0; |
87 | print "not " if "{\n (-1) ** \$a;\n}" |
88 | ne $deparse->coderef2text(sub{(-1) ** $a }); |
d4a0c6f3 |
89 | print "ok " . $i++ . "\n"; |
87a42246 |
90 | |
91 | # XXX ToDo - constsub that returns a reference |
92 | #use constant cr => ['hello']; |
93 | #my $string = "sub " . $deparse->coderef2text(\&cr); |
94 | #my $val = (eval $string)->(); |
95 | #print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello'; |
d4a0c6f3 |
96 | #print "ok " . $i++ . "\n"; |
87a42246 |
97 | |
98 | my $a; |
99 | my $Is_VMS = $^O eq 'VMS'; |
100 | my $Is_MacOS = $^O eq 'MacOS'; |
101 | |
102 | my $path = join " ", map { qq["-I$_"] } @INC; |
be708cc0 |
103 | $path .= " -MMac::err=unix" if $Is_MacOS; |
87a42246 |
104 | my $redir = $Is_MacOS ? "" : "2>&1"; |
105 | |
d2bc402e |
106 | $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 $redir`; |
e69a2255 |
107 | $a =~ s/-e syntax OK\n//g; |
d2bc402e |
108 | $a =~ s/.*possible typo.*\n//; # Remove warning line |
87a42246 |
109 | $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037 |
110 | $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc' |
111 | $b = <<'EOF'; |
d2bc402e |
112 | BEGIN { $^I = ".bak"; } |
113 | BEGIN { $^W = 1; } |
114 | BEGIN { $/ = "\n"; $\ = "\n"; } |
87a42246 |
115 | LINE: while (defined($_ = <ARGV>)) { |
116 | chomp $_; |
14a55f98 |
117 | our(@F) = split(" ", $_, 0); |
87a42246 |
118 | '???'; |
119 | } |
87a42246 |
120 | EOF |
e69a2255 |
121 | $b =~ s/(LINE:)/sub BEGIN { |
122 | 'MacPerl'->bootstrap; |
123 | 'OSA'->bootstrap; |
124 | 'XL'->bootstrap; |
125 | } |
126 | $1/ if $Is_MacOS; |
f99a63a2 |
127 | print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b; |
d4a0c6f3 |
128 | print "ok " . $i++ . "\n"; |
87a42246 |
129 | |
ad46c0be |
130 | __DATA__ |
14a55f98 |
131 | # 2 |
ad46c0be |
132 | 1; |
133 | #### |
14a55f98 |
134 | # 3 |
ad46c0be |
135 | { |
136 | no warnings; |
137 | '???'; |
138 | 2; |
139 | } |
140 | #### |
14a55f98 |
141 | # 4 |
ad46c0be |
142 | my $test; |
143 | ++$test and $test /= 2; |
144 | >>>> |
145 | my $test; |
146 | $test /= 2 if ++$test; |
147 | #### |
14a55f98 |
148 | # 5 |
ad46c0be |
149 | -((1, 2) x 2); |
150 | #### |
14a55f98 |
151 | # 6 |
ad46c0be |
152 | { |
153 | my $test = sub : lvalue { |
154 | my $x; |
155 | } |
156 | ; |
157 | } |
158 | #### |
14a55f98 |
159 | # 7 |
ad46c0be |
160 | { |
161 | my $test = sub : method { |
162 | my $x; |
163 | } |
164 | ; |
165 | } |
166 | #### |
14a55f98 |
167 | # 8 |
ad46c0be |
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 |
179 | continue { |
180 | 123; |
87a42246 |
181 | } |
ce4e655d |
182 | #### |
14a55f98 |
183 | # 10 |
ce4e655d |
184 | my $x; |
185 | print $main::x; |
186 | #### |
14a55f98 |
187 | # 11 |
ce4e655d |
188 | my @x; |
189 | print $main::x[1]; |
14a55f98 |
190 | #### |
191 | # 12 |
192 | my %x; |
193 | $x{warn()}; |
ad8caead |
194 | #### |
195 | # 13 |
196 | my $foo; |
197 | $_ .= <ARGV> . <$foo>; |
cef22867 |
198 | #### |
199 | # 14 |
200 | my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ"; |
4ae52e81 |
201 | #### |
202 | # 15 |
203 | s/x/'y';/e; |