Commit | Line | Data |
---|---|---|
87a42246 MS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
738f9dbf | 4 | splice @INC, 0, 0, 't', '.'; |
9cd8f857 NC |
5 | require Config; |
6 | if (($Config::Config{'extensions'} !~ /\bB\b/) ){ | |
7 | print "1..0 # Skip -- Perl configured without B module\n"; | |
8 | exit 0; | |
9 | } | |
738f9dbf | 10 | require 'test.pl'; |
87a42246 MS |
11 | } |
12 | ||
87a42246 MS |
13 | use warnings; |
14 | use strict; | |
87a42246 | 15 | |
a9cafc78 | 16 | my $tests = 49; # not counting those in the __DATA__ section |
3036b99c | 17 | |
87a42246 | 18 | use B::Deparse; |
09d856fb | 19 | my $deparse = B::Deparse->new(); |
507a68aa | 20 | isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object'); |
4da9a2ca | 21 | my %deparse; |
87a42246 | 22 | |
ad46c0be RH |
23 | $/ = "\n####\n"; |
24 | while (<DATA>) { | |
25 | chomp; | |
d8cf01c3 | 26 | $tests ++; |
e9c69003 NC |
27 | # This code is pinched from the t/lib/common.pl for TODO. |
28 | # It's not clear how to avoid duplication | |
a6087f24 | 29 | my %meta = (context => ''); |
4da9a2ca | 30 | foreach my $what (qw(skip todo context options)) { |
c4a350e6 | 31 | s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1; |
b871937f NC |
32 | # If the SKIP reason starts ? then it's taken as a code snippet to |
33 | # evaluate. This provides the flexibility to have conditional SKIPs | |
c4a350e6 NC |
34 | if ($meta{$what} && $meta{$what} =~ s/^\?//) { |
35 | my $temp = eval $meta{$what}; | |
b871937f | 36 | if ($@) { |
c4a350e6 | 37 | die "# In \U$what\E code reason:\n# $meta{$what}\n$@"; |
b871937f | 38 | } |
c4a350e6 | 39 | $meta{$what} = $temp; |
e9c69003 | 40 | } |
e9c69003 NC |
41 | } |
42 | ||
4a4b8592 | 43 | s/^\s*#\s*(.*)$//mg; |
507a68aa NC |
44 | my $desc = $1; |
45 | die "Missing name in test $_" unless defined $desc; | |
e9c69003 | 46 | |
c4a350e6 | 47 | if ($meta{skip}) { |
f9d3bdea | 48 | SKIP: { skip($meta{skip}) }; |
e9c69003 NC |
49 | next; |
50 | } | |
51 | ||
ad46c0be RH |
52 | my ($input, $expected); |
53 | if (/(.*)\n>>>>\n(.*)/s) { | |
54 | ($input, $expected) = ($1, $2); | |
55 | } | |
56 | else { | |
57 | ($input, $expected) = ($_, $_); | |
58 | } | |
87a42246 | 59 | |
4da9a2ca FC |
60 | # parse options if necessary |
61 | my $deparse = $meta{options} | |
62 | ? $deparse{$meta{options}} ||= | |
63 | new B::Deparse split /,/, $meta{options} | |
64 | : $deparse; | |
65 | ||
27cbbc57 | 66 | my $code = "$meta{context};\n" . <<'EOC' . "sub {$input\n}"; |
a6087f24 NC |
67 | # Tell B::Deparse about our ambient pragmas |
68 | my ($hint_bits, $warning_bits, $hinthash); | |
69 | BEGIN { | |
70 | ($hint_bits, $warning_bits, $hinthash) = ($^H, ${^WARNING_BITS}, \%^H); | |
71 | } | |
72 | $deparse->ambient_pragmas ( | |
73 | hint_bits => $hint_bits, | |
74 | warning_bits => $warning_bits, | |
75 | '%^H' => $hinthash, | |
76 | ); | |
77 | EOC | |
27cbbc57 | 78 | my $coderef = eval $code; |
87a42246 | 79 | |
c9fa6ae9 | 80 | local $::TODO = $meta{todo}; |
ad46c0be | 81 | if ($@) { |
27cbbc57 DM |
82 | is($@, "", "compilation of $desc") |
83 | or diag "=============================================\n" | |
84 | . "CODE:\n--------\n$code\n--------\n" | |
85 | . "=============================================\n"; | |
ad46c0be RH |
86 | } |
87 | else { | |
88 | my $deparsed = $deparse->coderef2text( $coderef ); | |
31c6271a RD |
89 | my $regex = $expected; |
90 | $regex =~ s/(\S+)/\Q$1/g; | |
91 | $regex =~ s/\s+/\\s+/g; | |
92 | $regex = '^\{\s*' . $regex . '\s*\}$'; | |
b871937f | 93 | |
bc304ab2 DM |
94 | like($deparsed, qr/$regex/, $desc) |
95 | or diag "=============================================\n" | |
96 | . "CODE:\n--------\n$input\n--------\n" | |
97 | . "EXPECTED:\n--------\n{\n$expected\n}\n--------\n" | |
98 | . "GOT:\n--------\n$deparsed\n--------\n" | |
99 | . "=============================================\n"; | |
87a42246 | 100 | } |
87a42246 MS |
101 | } |
102 | ||
9187b6e4 FC |
103 | # Reset the ambient pragmas |
104 | { | |
105 | my ($b, $w, $h); | |
106 | BEGIN { | |
107 | ($b, $w, $h) = ($^H, ${^WARNING_BITS}, \%^H); | |
108 | } | |
109 | $deparse->ambient_pragmas ( | |
110 | hint_bits => $b, | |
111 | warning_bits => $w, | |
112 | '%^H' => $h, | |
113 | ); | |
114 | } | |
115 | ||
87a42246 | 116 | use constant 'c', 'stuff'; |
507a68aa NC |
117 | is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff', |
118 | 'the subroutine generated by use constant deparses'); | |
87a42246 | 119 | |
09d856fb | 120 | my $a = 0; |
507a68aa NC |
121 | is($deparse->coderef2text(sub{(-1) ** $a }), "{\n (-1) ** \$a;\n}", |
122 | 'anon sub capturing an external lexical'); | |
87a42246 | 123 | |
d989cdac SM |
124 | use constant cr => ['hello']; |
125 | my $string = "sub " . $deparse->coderef2text(\&cr); | |
0707d6cc | 126 | my $val = (eval $string)->() or diag $string; |
507a68aa NC |
127 | is(ref($val), 'ARRAY', 'constant array references deparse'); |
128 | is($val->[0], 'hello', 'and return the correct value'); | |
87a42246 | 129 | |
87a42246 | 130 | my $path = join " ", map { qq["-I$_"] } @INC; |
87a42246 | 131 | |
7cde0a5f | 132 | $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 2>&1`; |
e69a2255 | 133 | $a =~ s/-e syntax OK\n//g; |
d2bc402e | 134 | $a =~ s/.*possible typo.*\n//; # Remove warning line |
82f96200 | 135 | $a =~ s/.*-i used with no filenames.*\n//; # Remove warning line |
c96cf1c0 | 136 | $b = quotemeta <<'EOF'; |
d2bc402e RGS |
137 | BEGIN { $^I = ".bak"; } |
138 | BEGIN { $^W = 1; } | |
139 | BEGIN { $/ = "\n"; $\ = "\n"; } | |
18371617 | 140 | LINE: while (defined($_ = readline ARGV)) { |
87a42246 | 141 | chomp $_; |
f86ea535 | 142 | our(@F) = split(' ', $_, 0); |
87a42246 MS |
143 | '???'; |
144 | } | |
87a42246 | 145 | EOF |
c96cf1c0 FC |
146 | $b =~ s/our\\\(\\\@F\\\)/our[( ]\@F\\)?/; # accept both our @F and our(@F) |
147 | like($a, qr/$b/, | |
507a68aa | 148 | 'command line flags deparse as BEGIN blocks setting control variables'); |
87a42246 | 149 | |
5b4ee549 NC |
150 | $a = `$^X $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`; |
151 | $a =~ s/-e syntax OK\n//g; | |
6436970c | 152 | is($a, "use constant ('PI', 4);\n", |
5b4ee549 NC |
153 | "Proxy Constant Subroutines must not show up as (incorrect) prototypes"); |
154 | ||
a9cafc78 FC |
155 | $a = `$^X $path "-MO=Deparse" -e "sub foo(){1}" 2>&1`; |
156 | $a =~ s/-e syntax OK\n//g; | |
157 | is($a, "sub foo () {\n 1;\n}\n", | |
158 | "Main prog consisting of just a constant (via empty proto)"); | |
159 | ||
160 | $a = readpipe qq|$^X $path "-MO=Deparse"| | |
161 | .qq| -e "package F; sub f(){0} sub s{}"| | |
162 | .qq| -e "#line 123 four-five-six"| | |
163 | .qq| -e "package G; sub g(){0} sub s{}" 2>&1|; | |
164 | $a =~ s/-e syntax OK\n//g; | |
6fbf0c31 | 165 | like($a, qr/sub F::f \(\) \{\s*0;?\s*}/, |
a9cafc78 FC |
166 | "Constant is dumped in package in which other subs are dumped"); |
167 | unlike($a, qr/sub g/, | |
168 | "Constant is not dumped in package in which other subs are not dumped"); | |
169 | ||
579a54dc | 170 | #Re: perlbug #35857, patch #24505 |
b3980c39 YO |
171 | #handle warnings::register-ed packages properly. |
172 | package B::Deparse::Wrapper; | |
173 | use strict; | |
174 | use warnings; | |
175 | use warnings::register; | |
176 | sub getcode { | |
579a54dc | 177 | my $deparser = B::Deparse->new(); |
b3980c39 YO |
178 | return $deparser->coderef2text(shift); |
179 | } | |
180 | ||
2990415a FR |
181 | package Moo; |
182 | use overload '0+' => sub { 42 }; | |
183 | ||
b3980c39 YO |
184 | package main; |
185 | use strict; | |
186 | use warnings; | |
71c4dbc3 | 187 | use constant GLIPP => 'glipp'; |
2990415a FR |
188 | use constant PI => 4; |
189 | use constant OVERLOADED_NUMIFICATION => bless({}, 'Moo'); | |
3779476a | 190 | use Fcntl qw/O_TRUNC O_APPEND O_EXCL/; |
aaf9c2b2 | 191 | BEGIN { delete $::Fcntl::{O_APPEND}; } |
2990415a | 192 | use POSIX qw/O_CREAT/; |
b3980c39 | 193 | sub test { |
579a54dc RGS |
194 | my $val = shift; |
195 | my $res = B::Deparse::Wrapper::getcode($val); | |
507a68aa NC |
196 | like($res, qr/use warnings/, |
197 | '[perl #35857] [PATCH] B::Deparse doesnt handle warnings register properly'); | |
b3980c39 YO |
198 | } |
199 | my ($q,$p); | |
200 | my $x=sub { ++$q,++$p }; | |
201 | test($x); | |
202 | eval <<EOFCODE and test($x); | |
203 | package bar; | |
204 | use strict; | |
205 | use warnings; | |
206 | use warnings::register; | |
207 | package main; | |
208 | 1 | |
209 | EOFCODE | |
210 | ||
d1dc589d FC |
211 | # Exotic sub declarations |
212 | $a = `$^X $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`; | |
213 | $a =~ s/-e syntax OK\n//g; | |
214 | is($a, <<'EOCODG', "sub :::: and sub ::::::"); | |
215 | sub :::: { | |
216 | ||
217 | } | |
218 | sub :::::: { | |
219 | ||
220 | } | |
221 | EOCODG | |
222 | ||
f2734596 HE |
223 | # [perl #117311] |
224 | $a = `$^X $path "-MO=Deparse,-l" -e "map{ eval(0) }()" 2>&1`; | |
225 | $a =~ s/-e syntax OK\n//g; | |
226 | is($a, <<'EOCODH', "[perl #117311] [PATCH] -l option ('#line ...') does not emit ^Ls in the output"); | |
227 | #line 1 "-e" | |
228 | map { | |
229 | #line 1 "-e" | |
230 | eval 0;} (); | |
231 | EOCODH | |
232 | ||
640d5d41 FC |
233 | # [perl #33752] |
234 | { | |
235 | my $code = <<"EOCODE"; | |
236 | { | |
237 | our \$\x{1e1f}\x{14d}\x{14d}; | |
238 | } | |
239 | EOCODE | |
240 | my $deparsed | |
241 | = $deparse->coderef2text(eval "sub { our \$\x{1e1f}\x{14d}\x{14d} }" ); | |
242 | s/$ \n//x for $deparsed, $code; | |
243 | is $deparsed, $code, 'our $funny_Unicode_chars'; | |
244 | } | |
245 | ||
bdabb2d5 FC |
246 | # [perl #62500] |
247 | $a = | |
248 | `$^X $path "-MO=Deparse" -e "BEGIN{*CORE::GLOBAL::require=sub{1}}" 2>&1`; | |
249 | $a =~ s/-e syntax OK\n//g; | |
250 | is($a, <<'EOCODF', "CORE::GLOBAL::require override causing panick"); | |
251 | sub BEGIN { | |
252 | *CORE::GLOBAL::require = sub { | |
253 | 1; | |
254 | } | |
255 | ; | |
256 | } | |
257 | EOCODF | |
258 | ||
894e98ac FC |
259 | # [perl #91384] |
260 | $a = | |
261 | `$^X $path "-MO=Deparse" -e "BEGIN{*Acme::Acme:: = *Acme::}" 2>&1`; | |
262 | like($a, qr/-e syntax OK/, | |
263 | "Deparse does not hang when traversing stash circularities"); | |
264 | ||
bb8996b8 | 265 | # [perl #93990] |
08412a26 | 266 | @] = (); |
73f4c4fe | 267 | is($deparse->coderef2text(sub{ print "foo@{]}" }), |
bb8996b8 | 268 | q<{ |
73f4c4fe | 269 | print "foo@{]}"; |
08412a26 | 270 | }>, 'curly around to interpolate "@{]}"'); |
73f4c4fe | 271 | is($deparse->coderef2text(sub{ print "foo@{-}" }), |
bb8996b8 | 272 | q<{ |
73f4c4fe | 273 | print "foo@-"; |
bb8996b8 HY |
274 | }>, 'no need to curly around to interpolate "@-"'); |
275 | ||
1c74777c FC |
276 | # Strict hints in %^H are mercilessly suppressed |
277 | $a = | |
278 | `$^X $path "-MO=Deparse" -e "use strict; print;" 2>&1`; | |
279 | unlike($a, qr/BEGIN/, | |
280 | "Deparse does not emit strict hh hints"); | |
281 | ||
3036b99c FC |
282 | # ambient_pragmas should not mess with strict settings. |
283 | SKIP: { | |
284 | skip "requires 5.11", 1 unless $] >= 5.011; | |
285 | eval q` | |
3036b99c | 286 | BEGIN { |
d1718a7c | 287 | # Clear out all hints |
3036b99c | 288 | %^H = (); |
d1718a7c | 289 | $^H = 0; |
3036b99c FC |
290 | new B::Deparse -> ambient_pragmas(strict => 'all'); |
291 | } | |
292 | use 5.011; # should enable strict | |
293 | ok !eval '$do_noT_create_a_variable_with_this_name = 1', | |
294 | 'ambient_pragmas do not mess with compiling scope'; | |
295 | `; | |
296 | } | |
297 | ||
93a8ff62 FC |
298 | # multiple statements on format lines |
299 | $a = `$^X $path "-MO=Deparse" -e "format =" -e "\@" -e "x();z()" -e. 2>&1`; | |
300 | $a =~ s/-e syntax OK\n//g; | |
93a8ff62 FC |
301 | is($a, <<'EOCODH', 'multiple statements on format lines'); |
302 | format STDOUT = | |
303 | @ | |
304 | x(); z() | |
305 | . | |
306 | EOCODH | |
307 | ||
ddb55548 FC |
308 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], |
309 | prog => "format =\n\@\n\$;\n.\n"), | |
310 | <<'EOCODM', '$; on format line'; | |
311 | format STDOUT = | |
312 | @ | |
313 | $; | |
314 | . | |
315 | EOCODM | |
316 | ||
e56a605e FC |
317 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse,-l', $path ], |
318 | prog => "format =\n\@\n\$foo\n.\n"), | |
319 | <<'EOCODM', 'formats with -l'; | |
320 | format STDOUT = | |
321 | @ | |
322 | $foo | |
323 | . | |
324 | EOCODM | |
325 | ||
8b9fb2f9 FC |
326 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
327 | prog => "{ my \$x; format =\n\@\n\$x\n.\n}"), | |
328 | <<'EOCODN', 'formats nested inside blocks'; | |
329 | { | |
330 | my $x; | |
331 | format STDOUT = | |
332 | @ | |
333 | $x | |
334 | . | |
335 | } | |
336 | EOCODN | |
337 | ||
7741ceed FC |
338 | # CORE::format |
339 | $a = readpipe qq`$^X $path "-MO=Deparse" -e "use feature q|:all|;` | |
340 | .qq` my sub format; CORE::format =" -e. 2>&1`; | |
341 | like($a, qr/CORE::format/, 'CORE::format when lex format sub is in scope'); | |
342 | ||
fea7fb25 DM |
343 | # literal big chars under 'use utf8' |
344 | is($deparse->coderef2text(sub{ use utf8; /€/; }), | |
345 | '{ | |
346 | /\x{20ac}/; | |
347 | }', | |
348 | "qr/euro/"); | |
349 | ||
e54915d6 FC |
350 | # STDERR when deparsing sub calls |
351 | # For a short while the output included 'While deparsing' | |
352 | $a = `$^X $path "-MO=Deparse" -e "foo()" 2>&1`; | |
353 | $a =~ s/-e syntax OK\n//g; | |
354 | is($a, <<'EOCODI', 'no extra output when deparsing foo()'); | |
355 | foo(); | |
356 | EOCODI | |
357 | ||
84ed3992 FC |
358 | # Sub calls compiled before importation |
359 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], | |
360 | prog => 'BEGIN { | |
361 | require Test::More; | |
362 | Test::More::->import; | |
363 | is(*foo, *foo) | |
364 | }'), | |
365 | qr/&is\(/, | |
366 | 'sub calls compiled before importation of prototype subs'; | |
367 | ||
a93cf6e2 FC |
368 | # [perl #121050] Prototypes with whitespace |
369 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], | |
370 | prog => <<'EOCODO'), | |
371 | sub _121050(\$ \$) { } | |
372 | _121050($a,$b); | |
373 | sub _121050empty( ) {} | |
374 | () = _121050empty() + 1; | |
375 | EOCODO | |
376 | <<'EOCODP', '[perl #121050] prototypes with whitespace'; | |
377 | sub _121050 (\$ \$) { | |
378 | ||
379 | } | |
380 | _121050 $a, $b; | |
381 | sub _121050empty ( ) { | |
382 | ||
383 | } | |
384 | () = _121050empty + 1; | |
385 | EOCODP | |
386 | ||
7741ceed FC |
387 | # CORE::no |
388 | $a = readpipe qq`$^X $path "-MO=Deparse" -Xe ` | |
389 | .qq`"use feature q|:all|; my sub no; CORE::no less" 2>&1`; | |
e276dec7 | 390 | like($a, qr/my sub no;\n.*CORE::no less;/s, |
7741ceed FC |
391 | 'CORE::no after my sub no'); |
392 | ||
393 | # CORE::use | |
394 | $a = readpipe qq`$^X $path "-MO=Deparse" -Xe ` | |
395 | .qq`"use feature q|:all|; my sub use; CORE::use less" 2>&1`; | |
e276dec7 | 396 | like($a, qr/my sub use;\n.*CORE::use less;/s, |
7741ceed FC |
397 | 'CORE::use after my sub use'); |
398 | ||
399 | # CORE::__DATA__ | |
400 | $a = readpipe qq`$^X $path "-MO=Deparse" -Xe ` | |
401 | .qq`"use feature q|:all|; my sub __DATA__; ` | |
402 | .qq`CORE::__DATA__" 2>&1`; | |
e276dec7 | 403 | like($a, qr/my sub __DATA__;\n.*CORE::__DATA__/s, |
7741ceed FC |
404 | 'CORE::__DATA__ after my sub __DATA__'); |
405 | ||
fe8d6c18 FC |
406 | # sub declarations |
407 | $a = readpipe qq`$^X $path "-MO=Deparse" -e "sub foo{}" 2>&1`; | |
dd3f0a7a | 408 | like($a, qr/sub foo\s*\{\s+\}/, 'sub declarations'); |
67359f08 FC |
409 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
410 | prog => 'sub f($); sub f($){}'), | |
411 | qr/sub f\s*\(\$\)\s*\{\s*\}/, | |
412 | 'predeclared prototyped subs'; | |
de001ba0 FC |
413 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
414 | prog => 'use Scalar::Util q-weaken-; | |
415 | sub f($); | |
416 | BEGIN { weaken($_=\$::{f}) }'), | |
417 | qr/sub f\s*\(\$\)\s*;/, | |
418 | 'prototyped stub with weak reference to the stash entry'; | |
03b8f76d FC |
419 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
420 | prog => 'sub f () { 42 }'), | |
421 | qr/sub f\s*\(\)\s*\{\s*42;\s*\}/, | |
422 | 'constant perl sub declaration'; | |
fe8d6c18 | 423 | |
8635e3c2 FC |
424 | # BEGIN blocks |
425 | SKIP : { | |
426 | skip "BEGIN output is wrong on old perls", 1 if $] < 5.021006; | |
427 | my $prog = ' | |
428 | BEGIN { pop } | |
429 | { | |
430 | BEGIN { pop } | |
431 | { | |
432 | no overloading; | |
433 | { | |
434 | BEGIN { pop } | |
435 | die | |
436 | } | |
437 | } | |
438 | }'; | |
439 | $prog =~ s/\n//g; | |
440 | $a = readpipe qq`$^X $path "-MO=Deparse" -e "$prog" 2>&1`; | |
441 | $a =~ s/-e syntax OK\n//g; | |
442 | is($a, <<'EOCODJ', 'BEGIN blocks'); | |
443 | sub BEGIN { | |
444 | pop @ARGV; | |
445 | } | |
446 | { | |
447 | sub BEGIN { | |
448 | pop @ARGV; | |
449 | } | |
450 | { | |
451 | no overloading; | |
452 | { | |
453 | sub BEGIN { | |
454 | pop @ARGV; | |
455 | } | |
456 | die; | |
457 | } | |
458 | } | |
459 | } | |
460 | EOCODJ | |
461 | } | |
34b54951 FC |
462 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], prog => ' |
463 | { | |
464 | { | |
465 | die; | |
466 | BEGIN { pop } | |
467 | } | |
468 | BEGIN { pop } | |
469 | } | |
470 | BEGIN { pop } | |
471 | '), <<'EOCODL', 'BEGIN blocks at the end of their enclosing blocks'; | |
472 | { | |
473 | { | |
474 | die; | |
475 | sub BEGIN { | |
476 | pop @ARGV; | |
477 | } | |
34b54951 FC |
478 | } |
479 | sub BEGIN { | |
480 | pop @ARGV; | |
481 | } | |
34b54951 FC |
482 | } |
483 | sub BEGIN { | |
484 | pop @ARGV; | |
485 | } | |
34b54951 | 486 | EOCODL |
93a8ff62 | 487 | |
c310a5ab FC |
488 | # BEGIN blocks should not be called __ANON__ |
489 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], | |
490 | prog => 'sub BEGIN { } CHECK { delete $::{BEGIN} }'), | |
491 | qr/sub BEGIN/, 'anonymised BEGIN'; | |
492 | ||
1f9498d0 | 493 | # [perl #115066] |
1f9498d0 FC |
494 | my $prog = 'use constant FOO => do { 1 }; no overloading; die'; |
495 | $a = readpipe qq`$^X $path "-MO=-qq,Deparse" -e "$prog" 2>&1`; | |
496 | is($a, <<'EOCODK', '[perl #115066] use statements accidentally nested'); | |
497 | use constant ('FOO', do { | |
d88d1fe0 | 498 | 1 |
1f9498d0 FC |
499 | }); |
500 | no overloading; | |
501 | die; | |
502 | EOCODK | |
503 | ||
f1013307 FC |
504 | # BEGIN blocks inside predeclared subs |
505 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], | |
506 | prog => ' | |
507 | sub run_tests; | |
508 | run_tests(); | |
509 | sub run_tests { BEGIN { } die }'), | |
510 | qr/sub run_tests \{\s*sub BEGIN/, | |
511 | 'BEGIN block inside predeclared sub'; | |
512 | ||
d49c3562 | 513 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
d98ae4a6 FC |
514 | prog => 'package foo; use overload qr=>sub{}'), |
515 | qr/package foo;\s*use overload/, | |
516 | 'package, then use'; | |
517 | ||
518 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], | |
d49c3562 FC |
519 | prog => 'use feature lexical_subs=>; my sub f;sub main::f{}'), |
520 | qr/^sub main::f \{/m, | |
521 | 'sub decl when lex sub is in scope'; | |
522 | ||
f518ad75 FC |
523 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
524 | prog => 'sub foo{foo()}'), | |
525 | qr/^sub foo \{\s+foo\(\)/m, | |
526 | 'recursive sub'; | |
527 | ||
2c5ddcd3 FC |
528 | like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
529 | prog => 'use feature lexical_subs=>state=>; | |
530 | state sub sb5; sub { sub sb5 { } }'), | |
401e2e00 | 531 | qr/sub \{\s*\(\);\s*sub sb5 \{/m, |
2c5ddcd3 FC |
532 | 'state sub in anon sub but declared outside'; |
533 | ||
5e965771 FC |
534 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], |
535 | prog => 'BEGIN { $::{f}=\!0 }'), | |
536 | "sub BEGIN {\n \$main::{'f'} = \\1;\n}\n", | |
537 | '&PL_sv_yes constant (used to croak)'; | |
538 | ||
d02d1323 FC |
539 | is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], |
540 | prog => '$x =~ (1?/$a/:0)'), | |
541 | '$x =~ ($_ =~ /$a/);'."\n", | |
542 | '$foo =~ <branch-folded match> under taint mode'; | |
543 | ||
62ae7cfb FC |
544 | unlike runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-w' ], |
545 | prog => 'BEGIN { undef &foo }'), | |
546 | qr'Use of uninitialized value', | |
547 | 'no warnings for undefined sub'; | |
548 | ||
d8cf01c3 | 549 | done_testing($tests); |
507a68aa | 550 | |
ad46c0be | 551 | __DATA__ |
b8346d05 KW |
552 | # TODO [perl #120950] This succeeds when run a 2nd time |
553 | # y/uni/code/ | |
554 | tr/\x{345}/\x{370}/; | |
555 | #### | |
556 | # y/uni/code/ [perl #120950] This 2nd instance succeeds | |
557 | tr/\x{345}/\x{370}/; | |
558 | #### | |
507a68aa | 559 | # A constant |
ad46c0be RH |
560 | 1; |
561 | #### | |
507a68aa | 562 | # Constants in a block |
f5b5c2a3 | 563 | # CONTEXT no warnings; |
ad46c0be | 564 | { |
ad46c0be RH |
565 | '???'; |
566 | 2; | |
567 | } | |
568 | #### | |
40ced2f4 FC |
569 | # List of constants in void context |
570 | # CONTEXT no warnings; | |
571 | (1,2,3); | |
572 | 0; | |
573 | >>>> | |
574 | '???', '???', '???'; | |
575 | 0; | |
576 | #### | |
507a68aa | 577 | # Lexical and simple arithmetic |
ad46c0be RH |
578 | my $test; |
579 | ++$test and $test /= 2; | |
580 | >>>> | |
581 | my $test; | |
582 | $test /= 2 if ++$test; | |
583 | #### | |
507a68aa | 584 | # list x |
ad46c0be RH |
585 | -((1, 2) x 2); |
586 | #### | |
6a861075 FC |
587 | # Assignment to list x |
588 | ((undef) x 3) = undef; | |
589 | #### | |
507a68aa | 590 | # lvalue sub |
ad46c0be RH |
591 | { |
592 | my $test = sub : lvalue { | |
593 | my $x; | |
594 | } | |
595 | ; | |
596 | } | |
597 | #### | |
507a68aa | 598 | # method |
ad46c0be RH |
599 | { |
600 | my $test = sub : method { | |
601 | my $x; | |
602 | } | |
603 | ; | |
604 | } | |
605 | #### | |
6b6b21da FC |
606 | # anonsub attrs at statement start |
607 | my $x = do { +sub : lvalue { my $y; } }; | |
608 | my $z = do { foo: +sub : method { my $a; } }; | |
609 | #### | |
507a68aa | 610 | # block with continue |
87a42246 | 611 | { |
ad46c0be | 612 | 234; |
f99a63a2 | 613 | } |
ad46c0be RH |
614 | continue { |
615 | 123; | |
87a42246 | 616 | } |
ce4e655d | 617 | #### |
507a68aa | 618 | # lexical and package scalars |
ce4e655d RH |
619 | my $x; |
620 | print $main::x; | |
621 | #### | |
507a68aa | 622 | # lexical and package arrays |
ce4e655d RH |
623 | my @x; |
624 | print $main::x[1]; | |
0ed5b3c8 | 625 | print \my @a; |
14a55f98 | 626 | #### |
507a68aa | 627 | # lexical and package hashes |
14a55f98 RH |
628 | my %x; |
629 | $x{warn()}; | |
ad8caead | 630 | #### |
66786896 FC |
631 | # our (LIST) |
632 | our($foo, $bar, $baz); | |
633 | #### | |
56cd2ef8 FC |
634 | # CONTEXT { package Dog } use feature "state"; |
635 | # variables with declared classes | |
636 | my Dog $spot; | |
637 | our Dog $spotty; | |
638 | state Dog $spotted; | |
639 | my Dog @spot; | |
640 | our Dog @spotty; | |
641 | state Dog @spotted; | |
642 | my Dog %spot; | |
643 | our Dog %spotty; | |
644 | state Dog %spotted; | |
645 | my Dog ($foo, @bar, %baz); | |
646 | our Dog ($phoo, @barr, %bazz); | |
647 | state Dog ($fough, @barre, %bazze); | |
648 | #### | |
f3515641 FC |
649 | # local our |
650 | local our $rhubarb; | |
5f4d8496 | 651 | local our($rhu, $barb); |
f3515641 | 652 | #### |
507a68aa | 653 | # <> |
ad8caead | 654 | my $foo; |
18371617 LM |
655 | $_ .= <> . <ARGV> . <$foo>; |
656 | <$foo>; | |
657 | <${foo}>; | |
658 | <$ foo>; | |
659 | >>>> | |
660 | my $foo; | |
661 | $_ .= readline(ARGV) . readline(ARGV) . readline($foo); | |
662 | readline $foo; | |
663 | glob $foo; | |
664 | glob $foo; | |
cef22867 | 665 | #### |
9cef6114 FC |
666 | # readline |
667 | readline 'FH'; | |
668 | readline *$_; | |
18371617 LM |
669 | readline *{$_}; |
670 | readline ${"a"}; | |
671 | >>>> | |
672 | readline 'FH'; | |
673 | readline *$_; | |
9cef6114 | 674 | readline *{$_;}; |
18371617 | 675 | readline ${'a';}; |
9cef6114 | 676 | #### |
2fcbb74a FC |
677 | # <<>> |
678 | $_ = <<>>; | |
679 | #### | |
507a68aa | 680 | # \x{} |
11454c59 | 681 | my $foo = "Ab\x{100}\200\x{200}\237Cd\000Ef\x{1000}\cA\x{2000}\cZ"; |
2a43599b | 682 | my $bar = "\x{100}"; |
4ae52e81 | 683 | #### |
2d5b99ed FC |
684 | # Latin-1 chars |
685 | # TODO ? ord("A") != 65 && "EBCDIC" | |
686 | my $baz = "B\366\x{100}"; | |
687 | my $bba = qr/B\366\x{100}/; | |
688 | #### | |
507a68aa | 689 | # s///e |
4ae52e81 | 690 | s/x/'y';/e; |
ef90d20a FC |
691 | s/x/$a;/e; |
692 | s/x/complex_expression();/e; | |
241416b8 | 693 | #### |
507a68aa | 694 | # block |
241416b8 DM |
695 | { my $x; } |
696 | #### | |
507a68aa | 697 | # while 1 |
241416b8 DM |
698 | while (1) { my $k; } |
699 | #### | |
507a68aa | 700 | # trailing for |
241416b8 DM |
701 | my ($x,@a); |
702 | $x=1 for @a; | |
703 | >>>> | |
704 | my($x, @a); | |
0bb5f065 | 705 | $x = 1 foreach (@a); |
241416b8 | 706 | #### |
507a68aa | 707 | # 2 arguments in a 3 argument for |
241416b8 DM |
708 | for (my $i = 0; $i < 2;) { |
709 | my $z = 1; | |
710 | } | |
711 | #### | |
507a68aa | 712 | # 3 argument for |
241416b8 DM |
713 | for (my $i = 0; $i < 2; ++$i) { |
714 | my $z = 1; | |
715 | } | |
716 | #### | |
507a68aa | 717 | # 3 argument for again |
241416b8 DM |
718 | for (my $i = 0; $i < 2; ++$i) { |
719 | my $z = 1; | |
720 | } | |
721 | #### | |
22584011 FC |
722 | # 3-argument for with inverted condition |
723 | for (my $i; not $i;) { | |
724 | die; | |
725 | } | |
726 | for (my $i; not $i; ++$i) { | |
727 | die; | |
728 | } | |
88a758b5 FC |
729 | for (my $a; not +($1 || 2) ** 2;) { |
730 | die; | |
731 | } | |
22584011 FC |
732 | Something_to_put_the_loop_in_void_context(); |
733 | #### | |
507a68aa | 734 | # while/continue |
241416b8 DM |
735 | my $i; |
736 | while ($i) { my $z = 1; } continue { $i = 99; } | |
737 | #### | |
507a68aa | 738 | # foreach with my |
09d856fb | 739 | foreach my $i (1, 2) { |
241416b8 DM |
740 | my $z = 1; |
741 | } | |
742 | #### | |
4da9a2ca FC |
743 | # OPTIONS -p |
744 | # foreach with my under -p | |
745 | foreach my $i (1) { | |
746 | die; | |
747 | } | |
748 | #### | |
507a68aa | 749 | # foreach |
241416b8 DM |
750 | my $i; |
751 | foreach $i (1, 2) { | |
752 | my $z = 1; | |
753 | } | |
754 | #### | |
507a68aa | 755 | # foreach, 2 mys |
241416b8 DM |
756 | my $i; |
757 | foreach my $i (1, 2) { | |
758 | my $z = 1; | |
759 | } | |
760 | #### | |
507a68aa | 761 | # foreach with our |
241416b8 DM |
762 | foreach our $i (1, 2) { |
763 | my $z = 1; | |
764 | } | |
765 | #### | |
507a68aa | 766 | # foreach with my and our |
241416b8 DM |
767 | my $i; |
768 | foreach our $i (1, 2) { | |
769 | my $z = 1; | |
770 | } | |
3ac6e0f9 | 771 | #### |
bcff4148 FC |
772 | # foreach with state |
773 | # CONTEXT use feature "state"; | |
774 | foreach state $i (1, 2) { | |
775 | state $z = 1; | |
776 | } | |
777 | #### | |
bba4f5ff FC |
778 | # foreach with sub call |
779 | foreach $_ (hcaerof()) { | |
780 | (); | |
781 | } | |
782 | #### | |
507a68aa | 783 | # reverse sort |
3ac6e0f9 RGS |
784 | my @x; |
785 | print reverse sort(@x); | |
786 | #### | |
507a68aa | 787 | # sort with cmp |
3ac6e0f9 RGS |
788 | my @x; |
789 | print((sort {$b cmp $a} @x)); | |
790 | #### | |
507a68aa | 791 | # reverse sort with block |
3ac6e0f9 RGS |
792 | my @x; |
793 | print((reverse sort {$b <=> $a} @x)); | |
36d57d93 | 794 | #### |
507a68aa | 795 | # foreach reverse |
36d57d93 RGS |
796 | our @a; |
797 | print $_ foreach (reverse @a); | |
aae53c41 | 798 | #### |
507a68aa | 799 | # foreach reverse (not inplace) |
aae53c41 RGS |
800 | our @a; |
801 | print $_ foreach (reverse 1, 2..5); | |
f86ea535 | 802 | #### |
507a68aa | 803 | # bug #38684 |
f86ea535 SM |
804 | our @ary; |
805 | @ary = split(' ', 'foo', 0); | |
31c6271a | 806 | #### |
5012eebe DM |
807 | my @ary; |
808 | @ary = split(' ', 'foo', 0); | |
809 | #### | |
de183bbb FC |
810 | # Split to our array |
811 | our @array = split(//, 'foo', 0); | |
812 | #### | |
ef7999f1 FC |
813 | # Split to my array |
814 | my @array = split(//, 'foo', 0); | |
815 | #### | |
5012eebe DM |
816 | our @array; |
817 | my $c; | |
818 | @array = split(/x(?{ $c++; })y/, 'foo', 0); | |
819 | #### | |
820 | my($x, $y, $p); | |
821 | our $c; | |
822 | ($x, $y) = split(/$p(?{ $c++; })y/, 'foo', 2); | |
823 | #### | |
824 | our @ary; | |
825 | my $pat; | |
826 | @ary = split(/$pat/, 'foo', 0); | |
827 | #### | |
828 | my @ary; | |
829 | our $pat; | |
830 | @ary = split(/$pat/, 'foo', 0); | |
831 | #### | |
832 | our @array; | |
833 | my $pat; | |
834 | local @array = split(/$pat/, 'foo', 0); | |
835 | #### | |
836 | our $pat; | |
837 | my @array = split(/$pat/, 'foo', 0); | |
838 | #### | |
507a68aa | 839 | # bug #40055 |
31c6271a RD |
840 | do { () }; |
841 | #### | |
507a68aa | 842 | # bug #40055 |
31c6271a | 843 | do { my $x = 1; $x }; |
d9002312 | 844 | #### |
507a68aa | 845 | # <20061012113037.GJ25805@c4.convolution.nl> |
d9002312 SM |
846 | my $f = sub { |
847 | +{[]}; | |
848 | } ; | |
8b2d6640 | 849 | #### |
507a68aa | 850 | # bug #43010 |
8b2d6640 FC |
851 | '!@$%'->(); |
852 | #### | |
507a68aa | 853 | # bug #43010 |
8b2d6640 FC |
854 | ::(); |
855 | #### | |
507a68aa | 856 | # bug #43010 |
8b2d6640 FC |
857 | '::::'->(); |
858 | #### | |
507a68aa | 859 | # bug #43010 |
8b2d6640 | 860 | &::::; |
09d856fb | 861 | #### |
1b38d782 FC |
862 | # [perl #77172] |
863 | package rt77172; | |
864 | sub foo {} foo & & & foo; | |
865 | >>>> | |
866 | package rt77172; | |
867 | foo(&{&} & foo()); | |
868 | #### | |
507a68aa | 869 | # variables as method names |
09d856fb CK |
870 | my $bar; |
871 | 'Foo'->$bar('orz'); | |
35a99a08 | 872 | 'Foo'->$bar('orz') = 'a stranger stranger than before'; |
09d856fb | 873 | #### |
507a68aa | 874 | # constants as method names |
09d856fb CK |
875 | 'Foo'->bar('orz'); |
876 | #### | |
507a68aa | 877 | # constants as method names without () |
09d856fb | 878 | 'Foo'->bar; |
0ced6c29 | 879 | #### |
28bfcb02 | 880 | # [perl #47359] "indirect" method call notation |
1bf8bbb0 FC |
881 | our @bar; |
882 | foo{@bar}+1,->foo; | |
883 | (foo{@bar}+1),foo(); | |
884 | foo{@bar}1 xor foo(); | |
885 | >>>> | |
886 | our @bar; | |
887 | (foo { @bar } 1)->foo; | |
888 | (foo { @bar } 1), foo(); | |
889 | foo { @bar } 1 xor foo(); | |
890 | #### | |
9d52f6f3 FC |
891 | # indirops with blocks |
892 | # CONTEXT use 5.01; | |
893 | print {*STDOUT;} 'foo'; | |
894 | printf {*STDOUT;} 'foo'; | |
895 | say {*STDOUT;} 'foo'; | |
896 | system {'foo';} '-foo'; | |
897 | exec {'foo';} '-foo'; | |
898 | #### | |
e9c69003 | 899 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" |
205fef88 | 900 | # CONTEXT use feature ':5.10'; |
507a68aa | 901 | # say |
7ddd1a01 NC |
902 | say 'foo'; |
903 | #### | |
8f57bb34 | 904 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" |
8f57bb34 NC |
905 | # CONTEXT use 5.10.0; |
906 | # say in the context of use 5.10.0 | |
907 | say 'foo'; | |
908 | #### | |
909 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
8f57bb34 NC |
910 | # say with use 5.10.0 |
911 | use 5.10.0; | |
912 | say 'foo'; | |
913 | >>>> | |
127ce1cd | 914 | no feature ':all'; |
8f57bb34 NC |
915 | use feature ':5.10'; |
916 | say 'foo'; | |
917 | #### | |
918 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
919 | # say with use feature ':5.10'; | |
920 | use feature ':5.10'; | |
921 | say 'foo'; | |
922 | >>>> | |
923 | use feature 'say', 'state', 'switch'; | |
924 | say 'foo'; | |
925 | #### | |
926 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
8f57bb34 NC |
927 | # CONTEXT use feature ':5.10'; |
928 | # say with use 5.10.0 in the context of use feature | |
929 | use 5.10.0; | |
930 | say 'foo'; | |
931 | >>>> | |
127ce1cd | 932 | no feature ':all'; |
8f57bb34 NC |
933 | use feature ':5.10'; |
934 | say 'foo'; | |
935 | #### | |
936 | # SKIP ?$] < 5.010 && "say not implemented on this Perl version" | |
937 | # CONTEXT use 5.10.0; | |
938 | # say with use feature ':5.10' in the context of use 5.10.0 | |
939 | use feature ':5.10'; | |
940 | say 'foo'; | |
941 | >>>> | |
942 | say 'foo'; | |
943 | #### | |
944 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
945 | # CONTEXT use feature ':5.15'; | |
946 | # __SUB__ | |
947 | __SUB__; | |
948 | #### | |
949 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
8f57bb34 NC |
950 | # CONTEXT use 5.15.0; |
951 | # __SUB__ in the context of use 5.15.0 | |
952 | __SUB__; | |
953 | #### | |
954 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
8f57bb34 NC |
955 | # __SUB__ with use 5.15.0 |
956 | use 5.15.0; | |
957 | __SUB__; | |
958 | >>>> | |
127ce1cd | 959 | no feature ':all'; |
8f57bb34 NC |
960 | use feature ':5.16'; |
961 | __SUB__; | |
962 | #### | |
963 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
964 | # __SUB__ with use feature ':5.15'; | |
965 | use feature ':5.15'; | |
966 | __SUB__; | |
967 | >>>> | |
968 | use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval'; | |
969 | __SUB__; | |
970 | #### | |
971 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
8f57bb34 NC |
972 | # CONTEXT use feature ':5.15'; |
973 | # __SUB__ with use 5.15.0 in the context of use feature | |
974 | use 5.15.0; | |
975 | __SUB__; | |
976 | >>>> | |
127ce1cd | 977 | no feature ':all'; |
8f57bb34 NC |
978 | use feature ':5.16'; |
979 | __SUB__; | |
980 | #### | |
981 | # SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" | |
982 | # CONTEXT use 5.15.0; | |
983 | # __SUB__ with use feature ':5.15' in the context of use 5.15.0 | |
984 | use feature ':5.15'; | |
985 | __SUB__; | |
986 | >>>> | |
987 | __SUB__; | |
988 | #### | |
e9c69003 | 989 | # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" |
205fef88 | 990 | # CONTEXT use feature ':5.10'; |
507a68aa | 991 | # state vars |
0ced6c29 RGS |
992 | state $x = 42; |
993 | #### | |
e9c69003 | 994 | # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" |
205fef88 | 995 | # CONTEXT use feature ':5.10'; |
507a68aa | 996 | # state var assignment |
7ddd1a01 NC |
997 | { |
998 | my $y = (state $x = 42); | |
999 | } | |
1000 | #### | |
e9c69003 | 1001 | # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" |
205fef88 | 1002 | # CONTEXT use feature ':5.10'; |
c4a6f826 | 1003 | # state vars in anonymous subroutines |
7ddd1a01 NC |
1004 | $a = sub { |
1005 | state $x; | |
1006 | return $x++; | |
1007 | } | |
1008 | ; | |
644741fd NC |
1009 | #### |
1010 | # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version' | |
507a68aa | 1011 | # each @array; |
644741fd NC |
1012 | each @ARGV; |
1013 | each @$a; | |
1014 | #### | |
1015 | # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version' | |
507a68aa | 1016 | # keys @array; values @array |
644741fd NC |
1017 | keys @$a if keys @ARGV; |
1018 | values @ARGV if values @$a; | |
35925e80 | 1019 | #### |
507a68aa | 1020 | # Anonymous arrays and hashes, and references to them |
35925e80 RGS |
1021 | my $a = {}; |
1022 | my $b = \{}; | |
1023 | my $c = []; | |
1024 | my $d = \[]; | |
9210de83 FR |
1025 | #### |
1026 | # SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version" | |
0f539b13 | 1027 | # CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch'; |
507a68aa | 1028 | # implicit smartmatch in given/when |
9210de83 FR |
1029 | given ('foo') { |
1030 | when ('bar') { continue; } | |
1031 | when ($_ ~~ 'quux') { continue; } | |
1032 | default { 0; } | |
1033 | } | |
7ecdd211 | 1034 | #### |
507a68aa | 1035 | # conditions in elsifs (regression in change #33710 which fixed bug #37302) |
7ecdd211 PJ |
1036 | if ($a) { x(); } |
1037 | elsif ($b) { x(); } | |
1038 | elsif ($a and $b) { x(); } | |
1039 | elsif ($a or $b) { x(); } | |
1040 | else { x(); } | |
03b22f1b | 1041 | #### |
507a68aa | 1042 | # interpolation in regexps |
03b22f1b RGS |
1043 | my($y, $t); |
1044 | /x${y}z$t/; | |
227375e1 | 1045 | #### |
4a4b8592 | 1046 | # TODO new undocumented cpan-bug #33708 |
507a68aa | 1047 | # cpan-bug #33708 |
227375e1 RU |
1048 | %{$_ || {}} |
1049 | #### | |
4a4b8592 | 1050 | # TODO hash constants not yet fixed |
507a68aa | 1051 | # cpan-bug #33708 |
227375e1 RU |
1052 | use constant H => { "#" => 1 }; H->{"#"} |
1053 | #### | |
4a4b8592 | 1054 | # TODO optimized away 0 not yet fixed |
507a68aa | 1055 | # cpan-bug #33708 |
227375e1 | 1056 | foreach my $i (@_) { 0 } |
edbe35ea | 1057 | #### |
507a68aa | 1058 | # tests with not, not optimized |
07f3cdf5 | 1059 | my $c; |
edbe35ea VP |
1060 | x() unless $a; |
1061 | x() if not $a and $b; | |
1062 | x() if $a and not $b; | |
1063 | x() unless not $a and $b; | |
1064 | x() unless $a and not $b; | |
1065 | x() if not $a or $b; | |
1066 | x() if $a or not $b; | |
1067 | x() unless not $a or $b; | |
1068 | x() unless $a or not $b; | |
07f3cdf5 VP |
1069 | x() if $a and not $b and $c; |
1070 | x() if not $a and $b and not $c; | |
1071 | x() unless $a and not $b and $c; | |
1072 | x() unless not $a and $b and not $c; | |
1073 | x() if $a or not $b or $c; | |
1074 | x() if not $a or $b or not $c; | |
1075 | x() unless $a or not $b or $c; | |
1076 | x() unless not $a or $b or not $c; | |
edbe35ea | 1077 | #### |
507a68aa | 1078 | # tests with not, optimized |
07f3cdf5 | 1079 | my $c; |
edbe35ea VP |
1080 | x() if not $a; |
1081 | x() unless not $a; | |
1082 | x() if not $a and not $b; | |
1083 | x() unless not $a and not $b; | |
1084 | x() if not $a or not $b; | |
1085 | x() unless not $a or not $b; | |
07f3cdf5 VP |
1086 | x() if not $a and not $b and $c; |
1087 | x() unless not $a and not $b and $c; | |
1088 | x() if not $a or not $b or $c; | |
1089 | x() unless not $a or not $b or $c; | |
1090 | x() if not $a and not $b and not $c; | |
1091 | x() unless not $a and not $b and not $c; | |
1092 | x() if not $a or not $b or not $c; | |
1093 | x() unless not $a or not $b or not $c; | |
1094 | x() unless not $a or not $b or not $c; | |
edbe35ea | 1095 | >>>> |
07f3cdf5 | 1096 | my $c; |
edbe35ea VP |
1097 | x() unless $a; |
1098 | x() if $a; | |
1099 | x() unless $a or $b; | |
1100 | x() if $a or $b; | |
1101 | x() unless $a and $b; | |
07f3cdf5 VP |
1102 | x() if $a and $b; |
1103 | x() if not $a || $b and $c; | |
1104 | x() unless not $a || $b and $c; | |
1105 | x() if not $a && $b or $c; | |
1106 | x() unless not $a && $b or $c; | |
1107 | x() unless $a or $b or $c; | |
1108 | x() if $a or $b or $c; | |
1109 | x() unless $a and $b and $c; | |
1110 | x() if $a and $b and $c; | |
1111 | x() unless not $a && $b && $c; | |
71c4dbc3 | 1112 | #### |
507a68aa | 1113 | # tests that should be constant folded |
71c4dbc3 VP |
1114 | x() if 1; |
1115 | x() if GLIPP; | |
1116 | x() if !GLIPP; | |
1117 | x() if GLIPP && GLIPP; | |
1118 | x() if !GLIPP || GLIPP; | |
1119 | x() if do { GLIPP }; | |
1120 | x() if do { no warnings 'void'; 5; GLIPP }; | |
1121 | x() if do { !GLIPP }; | |
1122 | if (GLIPP) { x() } else { z() } | |
1123 | if (!GLIPP) { x() } else { z() } | |
1124 | if (GLIPP) { x() } elsif (GLIPP) { z() } | |
1125 | if (!GLIPP) { x() } elsif (GLIPP) { z() } | |
1126 | if (GLIPP) { x() } elsif (!GLIPP) { z() } | |
1127 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } | |
1128 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } elsif (GLIPP) { t() } | |
1129 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } elsif (!GLIPP) { t() } | |
1130 | if (!GLIPP) { x() } elsif (!GLIPP) { z() } elsif (!GLIPP) { t() } | |
1131 | >>>> | |
1132 | x(); | |
1133 | x(); | |
1134 | '???'; | |
1135 | x(); | |
1136 | x(); | |
1137 | x(); | |
1138 | x(); | |
1139 | do { | |
1140 | '???' | |
1141 | }; | |
1142 | do { | |
1143 | x() | |
1144 | }; | |
1145 | do { | |
1146 | z() | |
1147 | }; | |
1148 | do { | |
1149 | x() | |
1150 | }; | |
1151 | do { | |
1152 | z() | |
1153 | }; | |
1154 | do { | |
1155 | x() | |
1156 | }; | |
1157 | '???'; | |
1158 | do { | |
1159 | t() | |
1160 | }; | |
1161 | '???'; | |
1162 | !1; | |
1163 | #### | |
719c50dc RGS |
1164 | # TODO constant deparsing has been backed out for 5.12 |
1165 | # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads" | |
507a68aa | 1166 | # tests that shouldn't be constant folded |
ac0f1413 NC |
1167 | # It might be fundamentally impossible to make this work on ithreads, in which |
1168 | # case the TODO should become a SKIP | |
71c4dbc3 VP |
1169 | x() if $a; |
1170 | if ($a == 1) { x() } elsif ($b == 2) { z() } | |
1171 | if (do { foo(); GLIPP }) { x() } | |
1172 | if (do { $a++; GLIPP }) { x() } | |
1173 | >>>> | |
1174 | x() if $a; | |
1175 | if ($a == 1) { x(); } elsif ($b == 2) { z(); } | |
2990415a FR |
1176 | if (do { foo(); GLIPP }) { x(); } |
1177 | if (do { ++$a; GLIPP }) { x(); } | |
1178 | #### | |
0fa4a265 | 1179 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1180 | # tests for deparsing constants |
2990415a FR |
1181 | warn PI; |
1182 | #### | |
0fa4a265 | 1183 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1184 | # tests for deparsing imported constants |
3779476a | 1185 | warn O_TRUNC; |
2990415a | 1186 | #### |
0fa4a265 | 1187 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1188 | # tests for deparsing re-exported constants |
2990415a FR |
1189 | warn O_CREAT; |
1190 | #### | |
0fa4a265 | 1191 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1192 | # tests for deparsing imported constants that got deleted from the original namespace |
aaf9c2b2 | 1193 | warn O_APPEND; |
2990415a | 1194 | #### |
0fa4a265 DM |
1195 | # TODO constant deparsing has been backed out for 5.12 |
1196 | # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads" | |
507a68aa | 1197 | # tests for deparsing constants which got turned into full typeglobs |
ac0f1413 NC |
1198 | # It might be fundamentally impossible to make this work on ithreads, in which |
1199 | # case the TODO should become a SKIP | |
2990415a FR |
1200 | warn O_EXCL; |
1201 | eval '@Fcntl::O_EXCL = qw/affe tiger/;'; | |
1202 | warn O_EXCL; | |
1203 | #### | |
0fa4a265 | 1204 | # TODO constant deparsing has been backed out for 5.12 |
507a68aa | 1205 | # tests for deparsing of blessed constant with overloaded numification |
2990415a | 1206 | warn OVERLOADED_NUMIFICATION; |
79289e05 | 1207 | #### |
507a68aa | 1208 | # strict |
79289e05 | 1209 | no strict; |
415d4c68 FC |
1210 | print $x; |
1211 | use strict 'vars'; | |
1212 | print $main::x; | |
1213 | use strict 'subs'; | |
1214 | print $main::x; | |
1215 | use strict 'refs'; | |
1216 | print $main::x; | |
1217 | no strict 'vars'; | |
79289e05 NC |
1218 | $x; |
1219 | #### | |
1220 | # TODO Subsets of warnings could be encoded textually, rather than as bitflips. | |
507a68aa | 1221 | # subsets of warnings |
79289e05 NC |
1222 | no warnings 'deprecated'; |
1223 | my $x; | |
1224 | #### | |
1225 | # TODO Better test for CPAN #33708 - the deparsed code has different behaviour | |
507a68aa | 1226 | # CPAN #33708 |
79289e05 NC |
1227 | use strict; |
1228 | no warnings; | |
1229 | ||
1230 | foreach (0..3) { | |
1231 | my $x = 2; | |
1232 | { | |
1233 | my $x if 0; | |
1234 | print ++$x, "\n"; | |
1235 | } | |
1236 | } | |
d83f38d8 | 1237 | #### |
507a68aa | 1238 | # no attribute list |
d83f38d8 NC |
1239 | my $pi = 4; |
1240 | #### | |
2dc78664 NC |
1241 | # SKIP ?$] > 5.013006 && ":= is now a syntax error" |
1242 | # := treated as an empty attribute list | |
d83f38d8 NC |
1243 | no warnings; |
1244 | my $pi := 4; | |
1245 | >>>> | |
1246 | no warnings; | |
1247 | my $pi = 4; | |
1248 | #### | |
507a68aa | 1249 | # : = empty attribute list |
d83f38d8 NC |
1250 | my $pi : = 4; |
1251 | >>>> | |
1252 | my $pi = 4; | |
689e417f | 1253 | #### |
507a68aa | 1254 | # in place sort |
689e417f VP |
1255 | our @a; |
1256 | my @b; | |
1257 | @a = sort @a; | |
1258 | @b = sort @b; | |
1259 | (); | |
1260 | #### | |
507a68aa | 1261 | # in place reverse |
689e417f VP |
1262 | our @a; |
1263 | my @b; | |
1264 | @a = reverse @a; | |
1265 | @b = reverse @b; | |
1266 | (); | |
06fc6867 | 1267 | #### |
507a68aa | 1268 | # #71870 Use of uninitialized value in bitwise and B::Deparse |
06fc6867 VP |
1269 | my($r, $s, @a); |
1270 | @a = split(/foo/, $s, 0); | |
1271 | $r = qr/foo/; | |
1272 | @a = split(/$r/, $s, 0); | |
1273 | (); | |
98a1a137 | 1274 | #### |
507a68aa | 1275 | # package declaration before label |
98a1a137 Z |
1276 | { |
1277 | package Foo; | |
1278 | label: print 123; | |
1279 | } | |
538f5756 | 1280 | #### |
507a68aa | 1281 | # shift optimisation |
538f5756 RZ |
1282 | shift; |
1283 | >>>> | |
1284 | shift(); | |
1285 | #### | |
507a68aa | 1286 | # shift optimisation |
538f5756 RZ |
1287 | shift @_; |
1288 | #### | |
507a68aa | 1289 | # shift optimisation |
538f5756 RZ |
1290 | pop; |
1291 | >>>> | |
1292 | pop(); | |
1293 | #### | |
507a68aa | 1294 | # shift optimisation |
538f5756 | 1295 | pop @_; |
a539498a | 1296 | #### |
507a68aa | 1297 | #[perl #20444] |
a539498a FC |
1298 | "foo" =~ (1 ? /foo/ : /bar/); |
1299 | "foo" =~ (1 ? y/foo// : /bar/); | |
5e5a1632 | 1300 | "foo" =~ (1 ? y/foo//r : /bar/); |
a539498a FC |
1301 | "foo" =~ (1 ? s/foo// : /bar/); |
1302 | >>>> | |
1303 | 'foo' =~ ($_ =~ /foo/); | |
1304 | 'foo' =~ ($_ =~ tr/fo//); | |
5e5a1632 | 1305 | 'foo' =~ ($_ =~ tr/fo//r); |
a539498a | 1306 | 'foo' =~ ($_ =~ s/foo//); |
e0ab66ad | 1307 | #### |
5e5a1632 FC |
1308 | # The fix for [perl #20444] broke this. |
1309 | 'foo' =~ do { () }; | |
1310 | #### | |
4b58603b FC |
1311 | # [perl #81424] match against aelemfast_lex |
1312 | my @s; | |
1313 | print /$s[1]/; | |
1314 | #### | |
36727b53 FC |
1315 | # /$#a/ |
1316 | print /$#main::a/; | |
1317 | #### | |
bae5b54e FC |
1318 | # /@array/ |
1319 | our @a; | |
1320 | my @b; | |
1321 | print /@a/; | |
1322 | print /@b/; | |
1323 | print qr/@a/; | |
1324 | print qr/@b/; | |
1325 | #### | |
3b91d897 FC |
1326 | # =~ QR_CONSTANT |
1327 | use constant QR_CONSTANT => qr/a/soupmix; | |
1328 | '' =~ QR_CONSTANT; | |
1329 | >>>> | |
1330 | '' =~ /a/impsux; | |
1331 | #### | |
9e32885a FC |
1332 | # $lexical =~ // |
1333 | my $x; | |
1334 | $x =~ //; | |
1335 | #### | |
b9bc576f | 1336 | # [perl #91318] /regexp/applaud |
09622ee2 FC |
1337 | print /a/a, s/b/c/a; |
1338 | print /a/aa, s/b/c/aa; | |
1339 | print /a/p, s/b/c/p; | |
1340 | print /a/l, s/b/c/l; | |
1341 | print /a/u, s/b/c/u; | |
b9bc576f FC |
1342 | { |
1343 | use feature "unicode_strings"; | |
09622ee2 | 1344 | print /a/d, s/b/c/d; |
b9bc576f FC |
1345 | } |
1346 | { | |
1347 | use re "/u"; | |
09622ee2 | 1348 | print /a/d, s/b/c/d; |
b9bc576f | 1349 | } |
dff5ffe4 FC |
1350 | { |
1351 | use 5.012; | |
1352 | print /a/d, s/b/c/d; | |
1353 | } | |
b9bc576f | 1354 | >>>> |
09622ee2 FC |
1355 | print /a/a, s/b/c/a; |
1356 | print /a/aa, s/b/c/aa; | |
1357 | print /a/p, s/b/c/p; | |
1358 | print /a/l, s/b/c/l; | |
1359 | print /a/u, s/b/c/u; | |
b9bc576f | 1360 | { |
a8095af7 | 1361 | use feature 'unicode_strings'; |
09622ee2 | 1362 | print /a/d, s/b/c/d; |
b9bc576f FC |
1363 | } |
1364 | { | |
0bb01b05 FC |
1365 | BEGIN { $^H{'reflags'} = '0'; |
1366 | $^H{'reflags_charset'} = '2'; } | |
09622ee2 | 1367 | print /a/d, s/b/c/d; |
b9bc576f | 1368 | } |
dff5ffe4 | 1369 | { |
127ce1cd | 1370 | no feature ':all'; |
dff5ffe4 FC |
1371 | use feature ':5.12'; |
1372 | print /a/d, s/b/c/d; | |
1373 | } | |
b9bc576f | 1374 | #### |
dc6dfd62 LM |
1375 | # all the flags (qr//) |
1376 | $_ = qr/X/m; | |
1377 | $_ = qr/X/s; | |
1378 | $_ = qr/X/i; | |
1379 | $_ = qr/X/x; | |
1380 | $_ = qr/X/p; | |
1381 | $_ = qr/X/o; | |
1382 | $_ = qr/X/u; | |
1383 | $_ = qr/X/a; | |
1384 | $_ = qr/X/l; | |
1385 | $_ = qr/X/n; | |
1386 | #### | |
1387 | use feature 'unicode_strings'; | |
1388 | $_ = qr/X/d; | |
1389 | #### | |
1390 | # all the flags (m//) | |
1391 | /X/m; | |
1392 | /X/s; | |
1393 | /X/i; | |
1394 | /X/x; | |
1395 | /X/p; | |
1396 | /X/o; | |
1397 | /X/u; | |
1398 | /X/a; | |
1399 | /X/l; | |
1400 | /X/n; | |
1401 | /X/g; | |
1402 | /X/cg; | |
1403 | #### | |
1404 | use feature 'unicode_strings'; | |
1405 | /X/d; | |
1406 | #### | |
1407 | # all the flags (s///) | |
1408 | s/X//m; | |
1409 | s/X//s; | |
1410 | s/X//i; | |
1411 | s/X//x; | |
1412 | s/X//p; | |
1413 | s/X//o; | |
1414 | s/X//u; | |
1415 | s/X//a; | |
1416 | s/X//l; | |
1417 | s/X//n; | |
1418 | s/X//g; | |
1419 | s/X/'';/e; | |
1420 | s/X//r; | |
1421 | #### | |
1422 | use feature 'unicode_strings'; | |
1423 | s/X//d; | |
1424 | #### | |
1425 | # all the flags (tr///) | |
1426 | tr/X/Y/c; | |
1427 | tr/X//d; | |
1428 | tr/X//s; | |
1429 | tr/X//r; | |
1430 | #### | |
9f125c4a FC |
1431 | # [perl #119807] s//\(3)/ge should not warn when deparsed (\3 warns) |
1432 | s/foo/\(3);/eg; | |
1433 | #### | |
c9fa6ae9 | 1434 | # [perl #115256] |
c9fa6ae9 FC |
1435 | "" =~ /a(?{ print q| |
1436 | |})/; | |
1437 | >>>> | |
f6b6ee63 | 1438 | '' =~ /a(?{ print "\n"; })/; |
c9fa6ae9 FC |
1439 | #### |
1440 | # [perl #123217] | |
c9fa6ae9 FC |
1441 | $_ = qr/(??{<<END})/ |
1442 | f.o | |
1443 | b.r | |
1444 | END | |
1445 | >>>> | |
1446 | $_ = qr/(??{ "f.o\nb.r\n"; })/; | |
1447 | #### | |
1448 | # More regexp code block madness | |
c9fa6ae9 FC |
1449 | my($b, @a); |
1450 | /(?{ die $b; })/; | |
1451 | /a(?{ die $b; })a/; | |
1452 | /$a(?{ die $b; })/; | |
1453 | /@a(?{ die $b; })/; | |
1454 | /(??{ die $b; })/; | |
1455 | /a(??{ die $b; })a/; | |
1456 | /$a(??{ die $b; })/; | |
1457 | /@a(??{ die $b; })/; | |
1458 | qr/(?{ die $b; })/; | |
1459 | qr/a(?{ die $b; })a/; | |
1460 | qr/$a(?{ die $b; })/; | |
1461 | qr/@a(?{ die $b; })/; | |
1462 | qr/(??{ die $b; })/; | |
1463 | qr/a(??{ die $b; })a/; | |
1464 | qr/$a(??{ die $b; })/; | |
1465 | qr/@a(??{ die $b; })/; | |
1466 | s/(?{ die $b; })//; | |
1467 | s/a(?{ die $b; })a//; | |
1468 | s/$a(?{ die $b; })//; | |
1469 | s/@a(?{ die $b; })//; | |
1470 | s/(??{ die $b; })//; | |
1471 | s/a(??{ die $b; })a//; | |
1472 | s/$a(??{ die $b; })//; | |
1473 | s/@a(??{ die $b; })//; | |
1474 | #### | |
ba0372a0 FC |
1475 | # /(?x)<newline><tab>/ |
1476 | /(?x) | |
1477 | /; | |
1478 | #### | |
e7afc405 | 1479 | # y///r |
d52196e1 | 1480 | tr/a/b/r + $a =~ tr/p/q/r; |
cb8157e3 | 1481 | #### |
12cea2fa FC |
1482 | # y///d in list [perl #119815] |
1483 | () = tr/a//d; | |
1484 | #### | |
cb8578ff | 1485 | # [perl #90898] |
f4002a4b | 1486 | <a,>; |
18371617 LM |
1487 | glob 'a,'; |
1488 | >>>> | |
1489 | glob 'a,'; | |
1490 | glob 'a,'; | |
09dcfa7d FC |
1491 | #### |
1492 | # [perl #91008] | |
26230909 | 1493 | # SKIP ?$] >= 5.023 && "autoderef deleted in this Perl version" |
d401967c | 1494 | # CONTEXT no warnings 'experimental::autoderef'; |
09dcfa7d FC |
1495 | each $@; |
1496 | keys $~; | |
1497 | values $!; | |
5d8c42c2 FC |
1498 | #### |
1499 | # readpipe with complex expression | |
1500 | readpipe $a + $b; | |
93bad3fd NC |
1501 | #### |
1502 | # aelemfast | |
1503 | $b::a[0] = 1; | |
1504 | #### | |
1505 | # aelemfast for a lexical | |
1506 | my @a; | |
1507 | $a[0] = 1; | |
80e3f4ad FC |
1508 | #### |
1509 | # feature features without feature | |
0f539b13 | 1510 | # CONTEXT no warnings 'experimental::smartmatch'; |
80e3f4ad | 1511 | CORE::state $x; |
223b1722 FC |
1512 | CORE::say $x; |
1513 | CORE::given ($x) { | |
1514 | CORE::when (3) { | |
1515 | continue; | |
1516 | } | |
1517 | CORE::default { | |
1518 | CORE::break; | |
1519 | } | |
1520 | } | |
1521 | CORE::evalbytes ''; | |
1522 | () = CORE::__SUB__; | |
838f2281 | 1523 | () = CORE::fc $x; |
223b1722 FC |
1524 | #### |
1525 | # feature features when feature has been disabled by use VERSION | |
0f539b13 | 1526 | # CONTEXT no warnings 'experimental::smartmatch'; |
223b1722 FC |
1527 | use feature (sprintf(":%vd", $^V)); |
1528 | use 1; | |
412989c2 | 1529 | CORE::say $_; |
223b1722 | 1530 | CORE::state $x; |
223b1722 FC |
1531 | CORE::given ($x) { |
1532 | CORE::when (3) { | |
1533 | continue; | |
1534 | } | |
1535 | CORE::default { | |
1536 | CORE::break; | |
1537 | } | |
1538 | } | |
1539 | CORE::evalbytes ''; | |
1540 | () = CORE::__SUB__; | |
1541 | >>>> | |
412989c2 | 1542 | CORE::say $_; |
205fef88 | 1543 | CORE::state $x; |
205fef88 NC |
1544 | CORE::given ($x) { |
1545 | CORE::when (3) { | |
1546 | continue; | |
1547 | } | |
1548 | CORE::default { | |
1549 | CORE::break; | |
1550 | } | |
1551 | } | |
1552 | CORE::evalbytes ''; | |
1553 | () = CORE::__SUB__; | |
1554 | #### | |
1555 | # (the above test with CONTEXT, and the output is equivalent but different) | |
0f539b13 | 1556 | # CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch'; |
205fef88 NC |
1557 | # feature features when feature has been disabled by use VERSION |
1558 | use feature (sprintf(":%vd", $^V)); | |
1559 | use 1; | |
412989c2 | 1560 | CORE::say $_; |
205fef88 | 1561 | CORE::state $x; |
205fef88 NC |
1562 | CORE::given ($x) { |
1563 | CORE::when (3) { | |
1564 | continue; | |
1565 | } | |
1566 | CORE::default { | |
1567 | CORE::break; | |
1568 | } | |
1569 | } | |
1570 | CORE::evalbytes ''; | |
1571 | () = CORE::__SUB__; | |
1572 | >>>> | |
127ce1cd | 1573 | no feature ':all'; |
0bb01b05 | 1574 | use feature ':default'; |
412989c2 | 1575 | CORE::say $_; |
223b1722 | 1576 | CORE::state $x; |
80e3f4ad FC |
1577 | CORE::given ($x) { |
1578 | CORE::when (3) { | |
1579 | continue; | |
1580 | } | |
1581 | CORE::default { | |
e36901c8 | 1582 | CORE::break; |
80e3f4ad FC |
1583 | } |
1584 | } | |
7d789282 | 1585 | CORE::evalbytes ''; |
84ed0108 | 1586 | () = CORE::__SUB__; |
6ec73527 | 1587 | #### |
7741ceed FC |
1588 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" |
1589 | # lexical subroutines and keywords of the same name | |
1590 | # CONTEXT use feature 'lexical_subs', 'switch'; no warnings 'experimental'; | |
1591 | my sub default; | |
1592 | my sub else; | |
1593 | my sub elsif; | |
1594 | my sub for; | |
1595 | my sub foreach; | |
1596 | my sub given; | |
1597 | my sub if; | |
1598 | my sub m; | |
1599 | my sub no; | |
1600 | my sub package; | |
1601 | my sub q; | |
1602 | my sub qq; | |
1603 | my sub qr; | |
1604 | my sub qx; | |
1605 | my sub require; | |
1606 | my sub s; | |
1607 | my sub sub; | |
1608 | my sub tr; | |
1609 | my sub unless; | |
1610 | my sub until; | |
1611 | my sub use; | |
1612 | my sub when; | |
1613 | my sub while; | |
1614 | CORE::default { die; } | |
1615 | CORE::if ($1) { die; } | |
1616 | CORE::if ($1) { die; } | |
1617 | CORE::elsif ($1) { die; } | |
1618 | CORE::else { die; } | |
1619 | CORE::for (die; $1; die) { die; } | |
1620 | CORE::foreach $_ (1 .. 10) { die; } | |
1621 | die CORE::foreach (1); | |
1622 | CORE::given ($1) { die; } | |
1623 | CORE::m[/]; | |
1624 | CORE::m?/?; | |
1625 | CORE::package foo; | |
1626 | CORE::no strict; | |
1627 | () = (CORE::q['], CORE::qq["$_], CORE::qr//, CORE::qx[`]); | |
1628 | CORE::require 1; | |
1629 | CORE::s///; | |
1630 | () = CORE::sub { die; } ; | |
1631 | CORE::tr///; | |
1632 | CORE::unless ($1) { die; } | |
1633 | CORE::until ($1) { die; } | |
1634 | die CORE::until $1; | |
1635 | CORE::use strict; | |
1636 | CORE::when ($1 ~~ $2) { die; } | |
1637 | CORE::while ($1) { die; } | |
1638 | die CORE::while $1; | |
1639 | #### | |
0bb01b05 FC |
1640 | # Feature hints |
1641 | use feature 'current_sub', 'evalbytes'; | |
1642 | print; | |
1643 | use 1; | |
1644 | print; | |
1645 | use 5.014; | |
1646 | print; | |
1647 | no feature 'unicode_strings'; | |
1648 | print; | |
1649 | >>>> | |
a8095af7 | 1650 | use feature 'current_sub', 'evalbytes'; |
0bb01b05 | 1651 | print $_; |
127ce1cd | 1652 | no feature ':all'; |
0bb01b05 FC |
1653 | use feature ':default'; |
1654 | print $_; | |
127ce1cd | 1655 | no feature ':all'; |
0bb01b05 FC |
1656 | use feature ':5.12'; |
1657 | print $_; | |
a8095af7 | 1658 | no feature 'unicode_strings'; |
0bb01b05 FC |
1659 | print $_; |
1660 | #### | |
6ec73527 FC |
1661 | # $#- $#+ $#{%} etc. |
1662 | my @x; | |
5b6da579 | 1663 | @x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}, $#{*}); |
6ec73527 FC |
1664 | @x = ($#{(}, $#{)}, $#{[}, $#{{}, $#{]}, $#{}}, $#{'}, $#{"}, $#{,}); |
1665 | @x = ($#{<}, $#{.}, $#{>}, $#{/}, $#{?}, $#{=}, $#+, $#{\}, $#{|}, $#-); | |
b6bba886 | 1666 | @x = ($#{;}, $#{:}, $#{1}), $#_; |
61154ac0 | 1667 | #### |
ff683671 NC |
1668 | # ${#} interpolated |
1669 | # It's a known TODO that warnings are deparsed as bits, not textually. | |
1670 | no warnings; | |
61154ac0 | 1671 | () = "${#}a"; |
958ed56b | 1672 | #### |
337d7381 FC |
1673 | # [perl #86060] $( $| $) in regexps need braces |
1674 | /${(}/; | |
1675 | /${|}/; | |
1676 | /${)}/; | |
1677 | /${(}${|}${)}/; | |
3f193e55 | 1678 | /@{+}@{-}/; |
337d7381 | 1679 | #### |
958ed56b FC |
1680 | # ()[...] |
1681 | my(@a) = ()[()]; | |
521795fe FC |
1682 | #### |
1683 | # sort(foo(bar)) | |
1684 | # sort(foo(bar)) is interpreted as sort &foo(bar) | |
1685 | # sort foo(bar) is interpreted as sort foo bar | |
1686 | # parentheses are not optional in this case | |
1687 | print sort(foo('bar')); | |
1688 | >>>> | |
1689 | print sort(foo('bar')); | |
24fcb59f FC |
1690 | #### |
1691 | # substr assignment | |
1692 | substr(my $a, 0, 0) = (foo(), bar()); | |
1693 | $a++; | |
04be0204 | 1694 | #### |
d1718a7c FC |
1695 | # This following line works around an unfixed bug that we are not trying to |
1696 | # test for here: | |
1697 | # CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised | |
04be0204 FC |
1698 | # hint hash |
1699 | BEGIN { $^H{'foo'} = undef; } | |
1700 | { | |
1701 | BEGIN { $^H{'bar'} = undef; } | |
1702 | { | |
1703 | BEGIN { $^H{'baz'} = undef; } | |
1704 | { | |
1705 | print $_; | |
1706 | } | |
1707 | print $_; | |
1708 | } | |
1709 | print $_; | |
1710 | } | |
035146a3 FC |
1711 | BEGIN { $^H{q[']} = '('; } |
1712 | print $_; | |
c306e834 | 1713 | #### |
d1718a7c FC |
1714 | # This following line works around an unfixed bug that we are not trying to |
1715 | # test for here: | |
1716 | # CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised | |
c306e834 FC |
1717 | # hint hash changes that serialise the same way with sort %hh |
1718 | BEGIN { $^H{'a'} = 'b'; } | |
1719 | { | |
1720 | BEGIN { $^H{'b'} = 'a'; delete $^H{'a'}; } | |
1721 | print $_; | |
1722 | } | |
1723 | print $_; | |
94bb57f9 FC |
1724 | #### |
1725 | # [perl #47361] do({}) and do +{} (variants of do-file) | |
1726 | do({}); | |
1727 | do +{}; | |
8b46c09b FC |
1728 | sub foo::do {} |
1729 | package foo; | |
1730 | CORE::do({}); | |
1731 | CORE::do +{}; | |
94bb57f9 FC |
1732 | >>>> |
1733 | do({}); | |
1734 | do({}); | |
8b46c09b FC |
1735 | package foo; |
1736 | CORE::do({}); | |
1737 | CORE::do({}); | |
9c56d9ea FC |
1738 | #### |
1739 | # [perl #77096] functions that do not follow the llafr | |
1740 | () = (return 1) + time; | |
1741 | () = (return ($1 + $2) * $3) + time; | |
1742 | () = (return ($a xor $b)) + time; | |
1743 | () = (do 'file') + time; | |
1744 | () = (do ($1 + $2) * $3) + time; | |
1745 | () = (do ($1 xor $2)) + time; | |
41df74e3 FC |
1746 | () = (goto 1) + 3; |
1747 | () = (require 'foo') + 3; | |
1748 | () = (require foo) + 3; | |
266da325 | 1749 | () = (CORE::dump 1) + 3; |
41df74e3 FC |
1750 | () = (last 1) + 3; |
1751 | () = (next 1) + 3; | |
1752 | () = (redo 1) + 3; | |
5830412d FC |
1753 | () = (-R $_) + 3; |
1754 | () = (-W $_) + 3; | |
1755 | () = (-X $_) + 3; | |
1756 | () = (-r $_) + 3; | |
1757 | () = (-w $_) + 3; | |
1758 | () = (-x $_) + 3; | |
2462c3cc | 1759 | #### |
917a8f4f FC |
1760 | # require(foo()) and do(foo()) |
1761 | require (foo()); | |
1762 | do (foo()); | |
df465735 FC |
1763 | goto (foo()); |
1764 | CORE::dump (foo()); | |
1765 | last (foo()); | |
1766 | next (foo()); | |
1767 | redo (foo()); | |
917a8f4f | 1768 | #### |
5e7acd25 FC |
1769 | # require vstring |
1770 | require v5.16; | |
1771 | #### | |
1cabb3b3 FC |
1772 | # [perl #97476] not() *does* follow the llafr |
1773 | $_ = ($a xor not +($1 || 2) ** 2); | |
1774 | #### | |
4d8ac5c7 FC |
1775 | # Precedence conundrums with argument-less function calls |
1776 | () = (eof) + 1; | |
1777 | () = (return) + 1; | |
1778 | () = (return, 1); | |
7bc8c979 FC |
1779 | () = warn; |
1780 | () = warn() + 1; | |
4d8ac5c7 FC |
1781 | () = setpgrp() + 1; |
1782 | #### | |
1eb0b7be FC |
1783 | # loopexes have assignment prec |
1784 | () = (CORE::dump a) | 'b'; | |
1785 | () = (goto a) | 'b'; | |
1786 | () = (last a) | 'b'; | |
1787 | () = (next a) | 'b'; | |
1788 | () = (redo a) | 'b'; | |
1789 | #### | |
2462c3cc FC |
1790 | # [perl #63558] open local(*FH) |
1791 | open local *FH; | |
564cd6cb | 1792 | pipe local *FH, local *FH; |
843b15cc | 1793 | #### |
b89b7257 FC |
1794 | # [perl #91416] open "string" |
1795 | open 'open'; | |
1796 | open '####'; | |
1797 | open '^A'; | |
1798 | open "\ca"; | |
1799 | >>>> | |
1800 | open *open; | |
1801 | open '####'; | |
1802 | open '^A'; | |
1803 | open *^A; | |
1804 | #### | |
be6cf5cf FC |
1805 | # "string"->[] ->{} |
1806 | no strict 'vars'; | |
1807 | () = 'open'->[0]; #aelemfast | |
1808 | () = '####'->[0]; | |
1809 | () = '^A'->[0]; | |
1810 | () = "\ca"->[0]; | |
b861b87f | 1811 | () = 'a::]b'->[0]; |
10e8e32b FC |
1812 | () = 'open'->[$_]; #aelem |
1813 | () = '####'->[$_]; | |
1814 | () = '^A'->[$_]; | |
1815 | () = "\ca"->[$_]; | |
b861b87f | 1816 | () = 'a::]b'->[$_]; |
10e8e32b FC |
1817 | () = 'open'->{0}; #helem |
1818 | () = '####'->{0}; | |
1819 | () = '^A'->{0}; | |
1820 | () = "\ca"->{0}; | |
b861b87f | 1821 | () = 'a::]b'->{0}; |
be6cf5cf | 1822 | >>>> |
415d4c68 | 1823 | no strict 'vars'; |
be6cf5cf FC |
1824 | () = $open[0]; |
1825 | () = '####'->[0]; | |
1826 | () = '^A'->[0]; | |
1827 | () = $^A[0]; | |
b861b87f | 1828 | () = 'a::]b'->[0]; |
10e8e32b FC |
1829 | () = $open[$_]; |
1830 | () = '####'->[$_]; | |
1831 | () = '^A'->[$_]; | |
1832 | () = $^A[$_]; | |
b861b87f | 1833 | () = 'a::]b'->[$_]; |
10e8e32b FC |
1834 | () = $open{'0'}; |
1835 | () = '####'->{'0'}; | |
1836 | () = '^A'->{'0'}; | |
1837 | () = $^A{'0'}; | |
b861b87f | 1838 | () = 'a::]b'->{'0'}; |
be6cf5cf | 1839 | #### |
843b15cc FC |
1840 | # [perl #74740] -(f()) vs -f() |
1841 | $_ = -(f()); | |
c75b4828 FC |
1842 | #### |
1843 | # require <binop> | |
1844 | require 'a' . $1; | |
afb60448 HY |
1845 | #### |
1846 | #[perl #30504] foreach-my postfix/prefix difference | |
1847 | $_ = 'foo' foreach my ($foo1, $bar1, $baz1); | |
1848 | foreach (my ($foo2, $bar2, $baz2)) { $_ = 'foo' } | |
1849 | foreach my $i (my ($foo3, $bar3, $baz3)) { $i = 'foo' } | |
1850 | >>>> | |
1851 | $_ = 'foo' foreach (my($foo1, $bar1, $baz1)); | |
1852 | foreach $_ (my($foo2, $bar2, $baz2)) { | |
1853 | $_ = 'foo'; | |
1854 | } | |
1855 | foreach my $i (my($foo3, $bar3, $baz3)) { | |
1856 | $i = 'foo'; | |
1857 | } | |
1858 | #### | |
1859 | #[perl #108224] foreach with continue block | |
1860 | foreach (1 .. 3) { print } continue { print "\n" } | |
1861 | foreach (1 .. 3) { } continue { } | |
1862 | foreach my $i (1 .. 3) { print $i } continue { print "\n" } | |
1863 | foreach my $i (1 .. 3) { } continue { } | |
1864 | >>>> | |
1865 | foreach $_ (1 .. 3) { | |
1866 | print $_; | |
1867 | } | |
1868 | continue { | |
1869 | print "\n"; | |
1870 | } | |
1871 | foreach $_ (1 .. 3) { | |
1872 | (); | |
1873 | } | |
1874 | continue { | |
1875 | (); | |
1876 | } | |
1877 | foreach my $i (1 .. 3) { | |
1878 | print $i; | |
1879 | } | |
1880 | continue { | |
1881 | print "\n"; | |
1882 | } | |
1883 | foreach my $i (1 .. 3) { | |
1884 | (); | |
1885 | } | |
1886 | continue { | |
1887 | (); | |
1888 | } | |
bc1cc2c3 DM |
1889 | #### |
1890 | # file handles | |
1891 | no strict; | |
1892 | my $mfh; | |
1893 | open F; | |
1894 | open *F; | |
1895 | open $fh; | |
1896 | open $mfh; | |
1897 | open 'a+b'; | |
1898 | select *F; | |
1899 | select F; | |
1900 | select $f; | |
1901 | select $mfh; | |
1902 | select 'a+b'; | |
a7fd8ef6 DM |
1903 | #### |
1904 | # 'my' works with padrange op | |
1905 | my($z, @z); | |
1906 | my $m1; | |
1907 | $m1 = 1; | |
1908 | $z = $m1; | |
1909 | my $m2 = 2; | |
1910 | my($m3, $m4); | |
1911 | ($m3, $m4) = (1, 2); | |
1912 | @z = ($m3, $m4); | |
1913 | my($m5, $m6) = (1, 2); | |
1914 | my($m7, undef, $m8) = (1, 2, 3); | |
1915 | @z = ($m7, undef, $m8); | |
1916 | ($m7, undef, $m8) = (1, 2, 3); | |
1917 | #### | |
1918 | # 'our/local' works with padrange op | |
a7fd8ef6 DM |
1919 | our($z, @z); |
1920 | our $o1; | |
0298c760 | 1921 | no strict; |
a7fd8ef6 DM |
1922 | local $o11; |
1923 | $o1 = 1; | |
1924 | local $o1 = 1; | |
1925 | $z = $o1; | |
1926 | $z = local $o1; | |
1927 | our $o2 = 2; | |
1928 | our($o3, $o4); | |
1929 | ($o3, $o4) = (1, 2); | |
1930 | local($o3, $o4) = (1, 2); | |
1931 | @z = ($o3, $o4); | |
1932 | @z = local($o3, $o4); | |
1933 | our($o5, $o6) = (1, 2); | |
1934 | our($o7, undef, $o8) = (1, 2, 3); | |
1935 | @z = ($o7, undef, $o8); | |
1936 | @z = local($o7, undef, $o8); | |
1937 | ($o7, undef, $o8) = (1, 2, 3); | |
1938 | local($o7, undef, $o8) = (1, 2, 3); | |
1939 | #### | |
1940 | # 'state' works with padrange op | |
412989c2 | 1941 | # CONTEXT no strict; use feature 'state'; |
a7fd8ef6 DM |
1942 | state($z, @z); |
1943 | state $s1; | |
1944 | $s1 = 1; | |
1945 | $z = $s1; | |
1946 | state $s2 = 2; | |
1947 | state($s3, $s4); | |
1948 | ($s3, $s4) = (1, 2); | |
1949 | @z = ($s3, $s4); | |
1950 | # assignment of state lists isn't implemented yet | |
1951 | #state($s5, $s6) = (1, 2); | |
1952 | #state($s7, undef, $s8) = (1, 2, 3); | |
1953 | #@z = ($s7, undef, $s8); | |
1954 | ($s7, undef, $s8) = (1, 2, 3); | |
1955 | #### | |
df2b00e8 | 1956 | # anon arrays with padrange |
a7fd8ef6 DM |
1957 | my($a, $b); |
1958 | my $c = [$a, $b]; | |
1959 | my $d = {$a, $b}; | |
1960 | #### | |
1961 | # slices with padrange | |
1962 | my($a, $b); | |
1963 | my(@x, %y); | |
1964 | @x = @x[$a, $b]; | |
1965 | @x = @y{$a, $b}; | |
1966 | #### | |
1967 | # binops with padrange | |
1968 | my($a, $b, $c); | |
1969 | $c = $a cmp $b; | |
1970 | $c = $a + $b; | |
1971 | $a += $b; | |
1972 | $c = $a - $b; | |
1973 | $a -= $b; | |
1974 | $c = my $a1 cmp $b; | |
1975 | $c = my $a2 + $b; | |
1976 | $a += my $b1; | |
1977 | $c = my $a3 - $b; | |
1978 | $a -= my $b2; | |
1979 | #### | |
1980 | # 'x' with padrange | |
1981 | my($a, $b, $c, $d, @e); | |
1982 | $c = $a x $b; | |
1983 | $a x= $b; | |
1984 | @e = ($a) x $d; | |
1985 | @e = ($a, $b) x $d; | |
1986 | @e = ($a, $b, $c) x $d; | |
1987 | @e = ($a, 1) x $d; | |
d5524600 DM |
1988 | #### |
1989 | # @_ with padrange | |
1990 | my($a, $b, $c) = @_; | |
ce4062e7 AC |
1991 | #### |
1992 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" | |
ce4062e7 | 1993 | # lexical subroutine |
db629560 | 1994 | # CONTEXT use feature 'lexical_subs'; |
601448c3 | 1995 | no warnings "experimental::lexical_subs"; |
ce4062e7 AC |
1996 | my sub f {} |
1997 | print f(); | |
d4f1bfe7 | 1998 | >>>> |
006c1a1d | 1999 | BEGIN {${^WARNING_BITS} = "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"} |
d4f1bfe7 | 2000 | my sub f { |
d4f1bfe7 FC |
2001 | |
2002 | } | |
d4f1bfe7 | 2003 | print f(); |
f0cf3754 AC |
2004 | #### |
2005 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" | |
f0cf3754 | 2006 | # lexical "state" subroutine |
db629560 | 2007 | # CONTEXT use feature 'state', 'lexical_subs'; |
f0cf3754 AC |
2008 | no warnings 'experimental::lexical_subs'; |
2009 | state sub f {} | |
2010 | print f(); | |
d4f1bfe7 | 2011 | >>>> |
006c1a1d | 2012 | BEGIN {${^WARNING_BITS} = "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"} |
db629560 | 2013 | state sub f { |
d4f1bfe7 FC |
2014 | |
2015 | } | |
d4f1bfe7 | 2016 | print f(); |
bcbe2b27 | 2017 | #### |
8443930e | 2018 | # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" |
8443930e FC |
2019 | # lexical subroutine scoping |
2020 | # CONTEXT use feature 'lexical_subs'; no warnings 'experimental::lexical_subs'; | |
2021 | { | |
2022 | { | |
2023 | my sub a { die; } | |
2024 | { | |
2025 | foo(); | |
2026 | my sub b; | |
bb9bfaa4 | 2027 | b ; |
8443930e | 2028 | main::b(); |
d49c3562 FC |
2029 | &main::b; |
2030 | &main::b(); | |
2031 | my $b = \&main::b; | |
2032 | sub b { $b; } | |
8443930e FC |
2033 | } |
2034 | } | |
2035 | b(); | |
2036 | } | |
2037 | #### | |
bb9bfaa4 FC |
2038 | # self-referential lexical subroutine |
2039 | # CONTEXT use feature 'lexical_subs', 'state'; no warnings 'experimental::lexical_subs'; | |
2040 | (); | |
2041 | state sub sb2; | |
2042 | sub sb2 { | |
2043 | sb2 ; | |
2044 | } | |
2045 | #### | |
494a4b9c FC |
2046 | # lexical subroutine with outer declaration and inner definition |
2047 | # CONTEXT use feature 'lexical_subs'; no warnings 'experimental::lexical_subs'; | |
2048 | (); | |
2049 | my sub f; | |
2050 | my sub g { | |
2051 | (); | |
2052 | sub f { } | |
2053 | } | |
2054 | #### | |
2c5ddcd3 FC |
2055 | # TODO only partially fixed |
2056 | # lexical state subroutine with outer declaration and inner definition | |
2057 | # CONTEXT use feature 'lexical_subs', 'state'; no warnings 'experimental::lexical_subs'; | |
2058 | (); | |
2059 | state sub sb4; | |
2060 | state sub a { | |
2061 | (); | |
2062 | sub sb4 { } | |
2063 | } | |
2064 | state sub sb5; | |
2065 | sub { | |
2066 | (); | |
2067 | sub sb5 { } | |
2068 | } ; | |
2069 | #### | |
bcbe2b27 FC |
2070 | # Elements of %# should not be confused with $#{ array } |
2071 | () = ${#}{'foo'}; | |
c4cf781e | 2072 | #### |
cfd916dd | 2073 | # $; [perl #123357] |
ddb55548 FC |
2074 | $_ = $;; |
2075 | do { | |
2076 | $; | |
2077 | }; | |
2078 | #### | |
c65b7c4d FC |
2079 | # Ampersand calls and scalar context |
2080 | # OPTIONS -P | |
2081 | package prototest; | |
2082 | sub foo($$); | |
2083 | foo(bar(),baz()); | |
2084 | >>>> | |
2085 | package prototest; | |
2086 | &foo(scalar bar(), scalar baz()); | |
2087 | #### | |
de4fa237 FC |
2088 | # coderef2text and prototyped sub calls [perl #123435] |
2089 | is 'foo', 'oo'; | |
2090 | #### | |
fd8be4a1 FC |
2091 | # prototypes with unary precedence |
2092 | package prototest; | |
2093 | sub dollar($) {} | |
2094 | sub optdollar(;$) {} | |
2095 | sub optoptdollar(;;$) {} | |
2096 | sub splat(*) {} | |
2097 | sub optsplat(;*) {} | |
2098 | sub optoptsplat(;;*) {} | |
2099 | sub bar(_) {} | |
2100 | sub optbar(;_) {} | |
2101 | sub optoptbar(;;_) {} | |
2102 | sub plus(+) {} | |
2103 | sub optplus(;+) {} | |
2104 | sub optoptplus(;;+) {} | |
2105 | sub wack(\$) {} | |
2106 | sub optwack(;\$) {} | |
2107 | sub optoptwack(;;\$) {} | |
2108 | sub wackbrack(\[$]) {} | |
2109 | sub optwackbrack(;\[$]) {} | |
2110 | sub optoptwackbrack(;;\[$]) {} | |
2111 | dollar($a < $b); | |
2112 | optdollar($a < $b); | |
2113 | optoptdollar($a < $b); | |
2114 | splat($a < $b); # Some of these deparse with ‘&’; if that changes, just | |
2115 | optsplat($a < $b); # change the tests. | |
2116 | optoptsplat($a < $b); | |
2117 | bar($a < $b); | |
2118 | optbar($a < $b); | |
2119 | optoptbar($a < $b); | |
2120 | plus($a < $b); | |
2121 | optplus($a < $b); | |
2122 | optoptplus($a < $b); | |
2123 | wack($a = $b); | |
2124 | optwack($a = $b); | |
2125 | optoptwack($a = $b); | |
2126 | wackbrack($a = $b); | |
2127 | optwackbrack($a = $b); | |
2128 | optoptwackbrack($a = $b); | |
2129 | >>>> | |
2130 | package prototest; | |
2131 | dollar($a < $b); | |
2132 | optdollar($a < $b); | |
2133 | optoptdollar($a < $b); | |
2134 | &splat($a < $b); | |
2135 | &optsplat($a < $b); | |
2136 | &optoptsplat($a < $b); | |
2137 | bar($a < $b); | |
2138 | optbar($a < $b); | |
2139 | optoptbar($a < $b); | |
2140 | &plus($a < $b); | |
2141 | &optplus($a < $b); | |
2142 | &optoptplus($a < $b); | |
2143 | &wack(\($a = $b)); | |
2144 | &optwack(\($a = $b)); | |
2145 | &optoptwack(\($a = $b)); | |
2146 | &wackbrack(\($a = $b)); | |
2147 | &optwackbrack(\($a = $b)); | |
2148 | &optoptwackbrack(\($a = $b)); | |
2149 | #### | |
b024352e DM |
2150 | # ensure aelemfast works in the range -128..127 and that there's no |
2151 | # funky edge cases | |
2152 | my $x; | |
2153 | no strict 'vars'; | |
2154 | $x = $a[-256] + $a[-255] + $a[-129] + $a[-128] + $a[-127] + $a[-1] + $a[0]; | |
2155 | $x = $a[1] + $a[126] + $a[127] + $a[128] + $a[255] + $a[256]; | |
2156 | my @b; | |
2157 | $x = $b[-256] + $b[-255] + $b[-129] + $b[-128] + $b[-127] + $b[-1] + $b[0]; | |
2158 | $x = $b[1] + $b[126] + $b[127] + $b[128] + $b[255] + $b[256]; | |
e09d73a6 DIM |
2159 | #### |
2160 | # 'm' must be preserved in m?? | |
2161 | m??; | |
c8ec376c FC |
2162 | #### |
2163 | # \(@array) and \(..., (@array), ...) | |
2164 | my(@array, %hash, @a, @b, %c, %d); | |
2165 | () = \(@array); | |
2166 | () = \(%hash); | |
2167 | () = \(@a, (@b), (%c), %d); | |
2168 | () = \(@Foo::array); | |
2169 | () = \(%Foo::hash); | |
2170 | () = \(@Foo::a, (@Foo::b), (%Foo::c), %Foo::d); | |
a958cfbb FC |
2171 | #### |
2172 | # subs synonymous with keywords | |
2173 | main::our(); | |
2174 | main::pop(); | |
2175 | state(); | |
2176 | use feature 'state'; | |
2177 | main::state(); | |
9187b6e4 FC |
2178 | #### |
2179 | # lvalue references | |
baabe3fb | 2180 | # CONTEXT use feature "state", 'refaliasing', 'lexical_subs'; no warnings 'experimental'; |
9187b6e4 FC |
2181 | our $x; |
2182 | \$x = \$x; | |
2183 | my $m; | |
2184 | \$m = \$x; | |
2185 | \my $n = \$x; | |
2186 | (\$x) = @_; | |
2187 | \($x) = @_; | |
2188 | \($m) = @_; | |
2189 | (\$m) = @_; | |
2190 | \my($p) = @_; | |
2191 | (\my $r) = @_; | |
2192 | \($x, my $a) = @{[\$x, \$x]}; | |
2193 | (\$x, \my $b) = @{[\$x, \$x]}; | |
2194 | \local $x = \3; | |
2195 | \local($x) = \3; | |
2196 | \state $c = \3; | |
2197 | \state($d) = \3; | |
2198 | \our $e = \3; | |
2199 | \our($f) = \3; | |
2200 | \$_[0] = foo(); | |
2201 | \($_[1]) = foo(); | |
2202 | my @a; | |
2203 | \$a[0] = foo(); | |
2204 | \($a[1]) = foo(); | |
2205 | \local($a[1]) = foo(); | |
2206 | \@a[0,1] = foo(); | |
2207 | \(@a[2,3]) = foo(); | |
2208 | \local @a[0,1] = (\$a)x2; | |
2209 | \$_{a} = foo(); | |
2210 | \($_{b}) = foo(); | |
2211 | my %h; | |
2212 | \$h{a} = foo(); | |
2213 | \($h{b}) = foo(); | |
2214 | \local $h{a} = \$x; | |
2215 | \local($h{b}) = \$x; | |
2216 | \@h{'a','b'} = foo(); | |
2217 | \(@h{2,3}) = foo(); | |
2218 | \local @h{'a','b'} = (\$x)x2; | |
2219 | \@_ = foo(); | |
2220 | \@a = foo(); | |
2221 | (\@_) = foo(); | |
2222 | (\@a) = foo(); | |
2223 | \my @c = foo(); | |
2224 | (\my @d) = foo(); | |
2225 | \(@_) = foo(); | |
2226 | \(@a) = foo(); | |
2227 | \my(@g) = foo(); | |
2228 | \local @_ = \@_; | |
2229 | (\local @_) = \@_; | |
2230 | \state @e = [1..3]; | |
2231 | \state(@f) = \3; | |
2232 | \our @i = [1..3]; | |
2233 | \our(@h) = \3; | |
2234 | \%_ = foo(); | |
2235 | \%h = foo(); | |
2236 | (\%_) = foo(); | |
2237 | (\%h) = foo(); | |
2238 | \my %c = foo(); | |
2239 | (\my %d) = foo(); | |
2240 | \local %_ = \%h; | |
2241 | (\local %_) = \%h; | |
2242 | \state %y = {1,2}; | |
2243 | \our %z = {1,2}; | |
2244 | (\our %zz) = {1,2}; | |
2245 | \&a = foo(); | |
2246 | (\&a) = foo(); | |
2247 | \(&a) = foo(); | |
2248 | { | |
2249 | my sub a; | |
2250 | \&a = foo(); | |
2251 | (\&a) = foo(); | |
2252 | \(&a) = foo(); | |
2253 | } | |
2254 | (\$_, $_) = \(1, 2); | |
2255 | $_ == 3 ? \$_ : $_ = \3; | |
2256 | $_ == 3 ? \$_ : \$x = \3; | |
2257 | \($_ == 3 ? $_ : $x) = \3; | |
2258 | for \my $topic (\$1, \$2) { | |
2259 | die; | |
2260 | } | |
2261 | for \state $topic (\$1, \$2) { | |
2262 | die; | |
2263 | } | |
2264 | for \our $topic (\$1, \$2) { | |
2265 | die; | |
2266 | } | |
2267 | for \$_ (\$1, \$2) { | |
2268 | die; | |
2269 | } | |
2270 | for \my @a ([1,2], [3,4]) { | |
2271 | die; | |
2272 | } | |
2273 | for \state @a ([1,2], [3,4]) { | |
2274 | die; | |
2275 | } | |
2276 | for \our @a ([1,2], [3,4]) { | |
2277 | die; | |
2278 | } | |
2279 | for \@_ ([1,2], [3,4]) { | |
2280 | die; | |
2281 | } | |
2282 | for \my %a ({5,6}, {7,8}) { | |
2283 | die; | |
2284 | } | |
2285 | for \our %a ({5,6}, {7,8}) { | |
2286 | die; | |
2287 | } | |
2288 | for \state %a ({5,6}, {7,8}) { | |
2289 | die; | |
2290 | } | |
2291 | for \%_ ({5,6}, {7,8}) { | |
2292 | die; | |
2293 | } | |
2294 | { | |
2295 | my sub a; | |
2296 | for \&a (sub { 9; }, sub { 10; }) { | |
2297 | die; | |
2298 | } | |
2299 | } | |
2300 | for \&a (sub { 9; }, sub { 10; }) { | |
2301 | die; | |
2302 | } | |
2303 | >>>> | |
2304 | our $x; | |
2305 | \$x = \$x; | |
2306 | my $m; | |
2307 | \$m = \$x; | |
2308 | \my $n = \$x; | |
2309 | (\$x) = @_; | |
2310 | (\$x) = @_; | |
2311 | (\$m) = @_; | |
2312 | (\$m) = @_; | |
2313 | (\my $p) = @_; | |
2314 | (\my $r) = @_; | |
2315 | (\$x, \my $a) = @{[\$x, \$x];}; | |
2316 | (\$x, \my $b) = @{[\$x, \$x];}; | |
2317 | \local $x = \3; | |
2318 | (\local $x) = \3; | |
2319 | \state $c = \3; | |
2320 | (\state $d) = \3; | |
2321 | \our $e = \3; | |
2322 | (\our $f) = \3; | |
2323 | \$_[0] = foo(); | |
2324 | (\$_[1]) = foo(); | |
2325 | my @a; | |
2326 | \$a[0] = foo(); | |
2327 | (\$a[1]) = foo(); | |
2328 | (\local $a[1]) = foo(); | |
2329 | (\@a[0, 1]) = foo(); | |
2330 | (\@a[2, 3]) = foo(); | |
2331 | (\local @a[0, 1]) = (\$a) x 2; | |
2332 | \$_{'a'} = foo(); | |
2333 | (\$_{'b'}) = foo(); | |
2334 | my %h; | |
2335 | \$h{'a'} = foo(); | |
2336 | (\$h{'b'}) = foo(); | |
2337 | \local $h{'a'} = \$x; | |
2338 | (\local $h{'b'}) = \$x; | |
2339 | (\@h{'a', 'b'}) = foo(); | |
2340 | (\@h{2, 3}) = foo(); | |
2341 | (\local @h{'a', 'b'}) = (\$x) x 2; | |
2342 | \@_ = foo(); | |
2343 | \@a = foo(); | |
2344 | (\@_) = foo(); | |
2345 | (\@a) = foo(); | |
2346 | \my @c = foo(); | |
2347 | (\my @d) = foo(); | |
2348 | (\(@_)) = foo(); | |
2349 | (\(@a)) = foo(); | |
2350 | (\(my @g)) = foo(); | |
2351 | \local @_ = \@_; | |
2352 | (\local @_) = \@_; | |
2353 | \state @e = [1..3]; | |
2354 | (\(state @f)) = \3; | |
2355 | \our @i = [1..3]; | |
2356 | (\(our @h)) = \3; | |
2357 | \%_ = foo(); | |
2358 | \%h = foo(); | |
2359 | (\%_) = foo(); | |
2360 | (\%h) = foo(); | |
2361 | \my %c = foo(); | |
2362 | (\my %d) = foo(); | |
2363 | \local %_ = \%h; | |
2364 | (\local %_) = \%h; | |
2365 | \state %y = {1, 2}; | |
2366 | \our %z = {1, 2}; | |
2367 | (\our %zz) = {1, 2}; | |
2368 | \&a = foo(); | |
2369 | (\&a) = foo(); | |
2370 | (\&a) = foo(); | |
2371 | { | |
2372 | my sub a; | |
2373 | \&a = foo(); | |
2374 | (\&a) = foo(); | |
2375 | (\&a) = foo(); | |
2376 | } | |
2377 | (\$_, $_) = \(1, 2); | |
2378 | $_ == 3 ? \$_ : $_ = \3; | |
2379 | $_ == 3 ? \$_ : \$x = \3; | |
2380 | ($_ == 3 ? \$_ : \$x) = \3; | |
2381 | foreach \my $topic (\$1, \$2) { | |
2382 | die; | |
2383 | } | |
2384 | foreach \state $topic (\$1, \$2) { | |
2385 | die; | |
2386 | } | |
2387 | foreach \our $topic (\$1, \$2) { | |
2388 | die; | |
2389 | } | |
2390 | foreach \$_ (\$1, \$2) { | |
2391 | die; | |
2392 | } | |
2393 | foreach \my @a ([1, 2], [3, 4]) { | |
2394 | die; | |
2395 | } | |
2396 | foreach \state @a ([1, 2], [3, 4]) { | |
2397 | die; | |
2398 | } | |
2399 | foreach \our @a ([1, 2], [3, 4]) { | |
2400 | die; | |
2401 | } | |
2402 | foreach \@_ ([1, 2], [3, 4]) { | |
2403 | die; | |
2404 | } | |
2405 | foreach \my %a ({5, 6}, {7, 8}) { | |
2406 | die; | |
2407 | } | |
2408 | foreach \our %a ({5, 6}, {7, 8}) { | |
2409 | die; | |
2410 | } | |
2411 | foreach \state %a ({5, 6}, {7, 8}) { | |
2412 | die; | |
2413 | } | |
2414 | foreach \%_ ({5, 6}, {7, 8}) { | |
2415 | die; | |
2416 | } | |
2417 | { | |
2418 | my sub a; | |
2419 | foreach \&a (sub { 9; } , sub { 10; } ) { | |
2420 | die; | |
2421 | } | |
2422 | } | |
2423 | foreach \&a (sub { 9; } , sub { 10; } ) { | |
2424 | die; | |
2425 | } | |
3b4e2a4d FC |
2426 | #### |
2427 | # join $foo, pos | |
2428 | my $foo; | |
2429 | $_ = join $foo, pos | |
2430 | >>>> | |
2431 | my $foo; | |
2432 | $_ = join('???', pos $_); | |
fedf30e1 DM |
2433 | #### |
2434 | # exists $a[0] | |
2435 | our @a; | |
2436 | exists $a[0]; | |
2437 | #### | |
2438 | # my @a; exists $a[0] | |
2439 | my @a; | |
2440 | exists $a[0]; | |
2441 | #### | |
2442 | # delete $a[0] | |
2443 | our @a; | |
2444 | delete $a[0]; | |
2445 | #### | |
2446 | # my @a; delete $a[0] | |
2447 | my @a; | |
2448 | delete $a[0]; | |
2449 | #### | |
2450 | # $_[0][$_[1]] | |
2451 | $_[0][$_[1]]; | |
2452 | #### | |
2453 | # f($a[0]); | |
2454 | my @a; | |
2455 | f($a[0]); | |
2456 | #### | |
2457 | #qr/\Q$h{'key'}\E/; | |
2458 | my %h; | |
2459 | qr/\Q$h{'key'}\E/; | |
2460 | #### | |
2461 | # my $x = "$h{foo}"; | |
2462 | my %h; | |
2463 | my $x = "$h{'foo'}"; | |
2464 | #### | |
2465 | # weird constant hash key | |
2466 | my %h; | |
2467 | my $x = $h{"\000\t\x{100}"}; | |
2468 | #### | |
2469 | # multideref and packages | |
2470 | package foo; | |
2471 | my(%bar) = ('a', 'b'); | |
2472 | our(@bar) = (1, 2); | |
2473 | $bar{'k'} = $bar[200]; | |
2474 | $main::bar{'k'} = $main::bar[200]; | |
2475 | $foo::bar{'k'} = $foo::bar[200]; | |
2476 | package foo2; | |
2477 | $bar{'k'} = $bar[200]; | |
2478 | $main::bar{'k'} = $main::bar[200]; | |
2479 | $foo::bar{'k'} = $foo::bar[200]; | |
2480 | >>>> | |
2481 | package foo; | |
2482 | my(%bar) = ('a', 'b'); | |
2483 | our(@bar) = (1, 2); | |
2484 | $bar{'k'} = $bar[200]; | |
2485 | $main::bar{'k'} = $main::bar[200]; | |
2486 | $foo::bar{'k'} = $bar[200]; | |
2487 | package foo2; | |
2488 | $bar{'k'} = $foo::bar[200]; | |
2489 | $main::bar{'k'} = $main::bar[200]; | |
2490 | $foo::bar{'k'} = $foo::bar[200]; | |
2491 | #### | |
2492 | # multideref and local | |
2493 | my %h; | |
2494 | local $h{'foo'}[0] = 1; | |
2495 | #### | |
2496 | # multideref and exists | |
2497 | my(%h, $i); | |
2498 | my $e = exists $h{'foo'}[$i]; | |
2499 | #### | |
2500 | # multideref and delete | |
2501 | my(%h, $i); | |
2502 | my $e = delete $h{'foo'}[$i]; | |
2503 | #### | |
2504 | # multideref with leading expression | |
2505 | my $r; | |
9527dbdd | 2506 | my $x = +($r // [])->{'foo'}[0]; |
fedf30e1 DM |
2507 | #### |
2508 | # multideref with complex middle index | |
2509 | my(%h, $i, $j, $k); | |
2510 | my $x = $h{'foo'}[$i + $j]{$k}; | |
0175f038 | 2511 | #### |
9527dbdd DM |
2512 | # multideref with trailing non-simple index that initially looks simple |
2513 | # (i.e. the constant "3") | |
2514 | my($r, $i, $j, $k); | |
2515 | my $x = +($r || {})->{'foo'}[$i + $j]{3 + $k}; | |
2516 | #### | |
3c4a43a5 FC |
2517 | # chdir |
2518 | chdir 'file'; | |
0175f038 | 2519 | chdir FH; |
3c4a43a5 | 2520 | chdir; |
27f31adf FC |
2521 | #### |
2522 | # 5.22 bitops | |
2523 | # CONTEXT use feature "bitwise"; no warnings "experimental::bitwise"; | |
2524 | $_ = $_ | $_; | |
2525 | $_ = $_ & $_; | |
2526 | $_ = $_ ^ $_; | |
2527 | $_ = ~$_; | |
2528 | $_ = $_ |. $_; | |
2529 | $_ = $_ &. $_; | |
2530 | $_ = $_ ^. $_; | |
2531 | $_ = ~.$_; | |
2532 | $_ |= $_; | |
2533 | $_ &= $_; | |
2534 | $_ ^= $_; | |
2535 | $_ |.= $_; | |
2536 | $_ &.= $_; | |
2537 | $_ ^.= $_; | |
60f638af DM |
2538 | #### |
2539 | #### | |
2540 | # Should really use 'no warnings "experimental::signatures"', | |
2541 | # but it doesn't yet deparse correctly. | |
2542 | # anon subs used because this test framework doesn't deparse named subs | |
2543 | # in the DATA code snippets. | |
2544 | # | |
2545 | # general signature | |
2546 | no warnings; | |
2547 | use feature 'signatures'; | |
2548 | my $x; | |
2549 | sub ($a, $, $b = $glo::bal, $c = $a, $d = 'foo', $e = -37, $f = 0, $g = 1, $h = undef, $i = $a + 1, $j = /foo/, @) { | |
2550 | $x++; | |
2551 | } | |
2552 | ; | |
2553 | $x++; | |
2554 | #### | |
2555 | # Signature and prototype | |
2556 | no warnings; | |
2557 | use feature 'signatures'; | |
2558 | my $x; | |
2559 | sub ($a, $b) : prototype($$) { | |
2560 | $x++; | |
2561 | } | |
2562 | ; | |
2563 | $x++; | |
2564 | #### | |
2565 | # Signature and prototype and attrs | |
2566 | no warnings; | |
2567 | use feature 'signatures'; | |
2568 | my $x; | |
2569 | sub ($a, $b) : prototype($$) lvalue { | |
2570 | $x++; | |
2571 | } | |
2572 | ; | |
2573 | $x++; | |
2574 | #### | |
2575 | # Signature and attrs | |
2576 | no warnings; | |
2577 | use feature 'signatures'; | |
2578 | my $x; | |
2579 | sub ($a, $b) : lvalue method { | |
2580 | $x++; | |
2581 | } | |
2582 | ; | |
2583 | $x++; | |
2584 | #### | |
2585 | # named array slurp, null body | |
2586 | no warnings; | |
2587 | use feature 'signatures'; | |
2588 | sub (@a) { | |
2589 | ; | |
2590 | } | |
2591 | ; | |
2592 | #### | |
2593 | # named hash slurp | |
2594 | no warnings; | |
2595 | use feature 'signatures'; | |
2596 | sub ($key, %h) { | |
2597 | $h{$key}; | |
2598 | } | |
2599 | ; | |
2600 | #### | |
2601 | # anon hash slurp | |
2602 | no warnings; | |
2603 | use feature 'signatures'; | |
2604 | sub ($a, %) { | |
2605 | $a; | |
2606 | } | |
2607 | ; | |
2608 | #### | |
2609 | # parenthesised default arg | |
2610 | no warnings; | |
2611 | use feature 'signatures'; | |
2612 | sub ($a, $b = (/foo/), $c = 1) { | |
2613 | $a + $b + $c; | |
2614 | } | |
2615 | ; | |
2616 | #### | |
2617 | # parenthesised default arg with TARGMY | |
2618 | no warnings; | |
2619 | use feature 'signatures'; | |
2620 | sub ($a, $b = ($a + 1), $c = 1) { | |
2621 | $a + $b + $c; | |
2622 | } | |
2623 | ; | |
2624 | #### | |
2625 | # empty default | |
2626 | no warnings; | |
2627 | use feature 'signatures'; | |
2628 | sub ($a, $=) { | |
2629 | $a; | |
2630 | } | |
2631 | ; | |
b814db67 DM |
2632 | #### |
2633 | # padrange op within pattern code blocks | |
2634 | /(?{ my($x, $y) = (); })/; | |
2635 | my $a; | |
2636 | /$a(?{ my($x, $y) = (); })/; | |
2637 | my $r1 = qr/(?{ my($x, $y) = (); })/; | |
2638 | my $r2 = qr/$a(?{ my($x, $y) = (); })/; | |
4d7ac81a DM |
2639 | #### |
2640 | # don't remove pattern whitespace escapes | |
2641 | /a\ b/; | |
2642 | /a\ b/x; | |
2643 | /a\ b/; | |
2644 | /a\ b/x; | |
82ab48fa DM |
2645 | #### |
2646 | # my attributes | |
2647 | my $s1 :foo(f1, f2) bar(b1, b2); | |
2648 | my @a1 :foo(f1, f2) bar(b1, b2); | |
2649 | my %h1 :foo(f1, f2) bar(b1, b2); | |
2650 | my($s2, @a2, %h2) :foo(f1, f2) bar(b1, b2); | |
2651 | #### | |
2652 | # my class attributes | |
2653 | package Foo::Bar; | |
2654 | my Foo::Bar $s1 :foo(f1, f2) bar(b1, b2); | |
2655 | my Foo::Bar @a1 :foo(f1, f2) bar(b1, b2); | |
2656 | my Foo::Bar %h1 :foo(f1, f2) bar(b1, b2); | |
2657 | my Foo::Bar ($s2, @a2, %h2) :foo(f1, f2) bar(b1, b2); | |
2658 | package main; | |
2659 | my Foo::Bar $s3 :foo(f1, f2) bar(b1, b2); | |
2660 | my Foo::Bar @a3 :foo(f1, f2) bar(b1, b2); | |
2661 | my Foo::Bar %h3 :foo(f1, f2) bar(b1, b2); | |
2662 | my Foo::Bar ($s4, @a4, %h4) :foo(f1, f2) bar(b1, b2); | |
2663 | #### | |
2664 | # avoid false positives in my $x :attribute | |
2665 | 'attributes'->import('main', \my $x1, 'foo(bar)'), my $y1; | |
2666 | 'attributes'->import('Fooo', \my $x2, 'foo(bar)'), my $y2; | |
ac1e5644 DM |
2667 | #### |
2668 | # hash slices and hash key/value slices | |
2669 | my(@a, %h); | |
2670 | our(@oa, %oh); | |
2671 | @a = @h{'foo', 'bar'}; | |
2672 | @a = %h{'foo', 'bar'}; | |
2673 | @a = delete @h{'foo', 'bar'}; | |
2674 | @a = delete %h{'foo', 'bar'}; | |
2675 | @oa = @oh{'foo', 'bar'}; | |
2676 | @oa = %oh{'foo', 'bar'}; | |
2677 | @oa = delete @oh{'foo', 'bar'}; | |
2678 | @oa = delete %oh{'foo', 'bar'}; | |
748f2c65 DM |
2679 | #### |
2680 | # keys optimised away in void and scalar context | |
2681 | no warnings; | |
2682 | ; | |
2683 | our %h1; | |
2684 | my($x, %h2); | |
2685 | %h1; | |
2686 | keys %h1; | |
2687 | $x = %h1; | |
2688 | $x = keys %h1; | |
2689 | %h2; | |
2690 | keys %h2; | |
2691 | $x = %h2; | |
2692 | $x = keys %h2; | |
7e8d786b DM |
2693 | #### |
2694 | # eq,const optimised away for (index() == -1) | |
2695 | my($a, $b); | |
2696 | our $c; | |
2697 | $c = index($a, $b) == 2; | |
2698 | $c = rindex($a, $b) == 2; | |
2699 | $c = index($a, $b) == -1; | |
2700 | $c = rindex($a, $b) == -1; | |
2701 | $c = index($a, $b) != -1; | |
2702 | $c = rindex($a, $b) != -1; | |
2703 | $c = (index($a, $b) == -1); | |
2704 | $c = (rindex($a, $b) == -1); | |
2705 | $c = (index($a, $b) != -1); | |
2706 | $c = (rindex($a, $b) != -1); | |
2707 | #### | |
2708 | # eq,const,sassign,madmy optimised away for (index() == -1) | |
2709 | my($a, $b); | |
2710 | my $c; | |
2711 | $c = index($a, $b) == 2; | |
2712 | $c = rindex($a, $b) == 2; | |
2713 | $c = index($a, $b) == -1; | |
2714 | $c = rindex($a, $b) == -1; | |
2715 | $c = index($a, $b) != -1; | |
2716 | $c = rindex($a, $b) != -1; | |
2717 | $c = (index($a, $b) == -1); | |
2718 | $c = (rindex($a, $b) == -1); | |
2719 | $c = (index($a, $b) != -1); | |
2720 | $c = (rindex($a, $b) != -1); | |
e839e6ed DM |
2721 | #### |
2722 | # plain multiconcat | |
2723 | my($a, $b, $c, $d, @a); | |
2724 | $d = length $a . $b . $c; | |
2725 | $d = length($a) . $b . $c; | |
2726 | print '' . $a; | |
2727 | push @a, ($a . '') * $b; | |
2728 | unshift @a, "$a" * ($b . ''); | |
2729 | print $a . 'x' . $b . $c; | |
2730 | print $a . 'x' . $b . $c, $d; | |
2731 | print $b . $c . ($a . $b); | |
2732 | print $b . $c . ($a . $b); | |
2733 | print $b . $c . @a; | |
2734 | print $a . "\x{100}"; | |
2735 | #### | |
2736 | # double-quoted multiconcat | |
2737 | my($a, $b, $c, $d, @a); | |
2738 | print "${a}x\x{100}$b$c"; | |
2739 | print "$a\Q$b\E$c\Ua$a\E\Lb$b\uc$c\E$a${b}c$c"; | |
2740 | print "A=$a[length 'b' . $c . 'd'] b=$b"; | |
2741 | print "A=@a B=$b"; | |
2742 | print "\x{101}$a\x{100}"; | |
2743 | $a = qr/\Q | |
2744 | $b $c | |
2745 | \x80 | |
2746 | \x{100} | |
2747 | \E$c | |
2748 | /; | |
2749 | #### | |
2750 | # sprintf multiconcat | |
2751 | my($a, $b, $c, $d, @a); | |
2752 | print sprintf("%s%s%%%sx%s\x{100}%s", $a, $b, $c, scalar @a, $d); | |
2753 | #### | |
2754 | # multiconcat with lexical assign | |
2755 | my($a, $b, $c, $d, $e, @a); | |
2756 | $d = 'foo' . $a; | |
2757 | $d = "foo$a"; | |
2758 | $d = $a . ''; | |
2759 | $d = 'foo' . $a . 'bar'; | |
2760 | $d = $a . $b; | |
2761 | $d = $a . $b . $c; | |
2762 | $d = $a . $b . $c . @a; | |
2763 | $e = ($d = $a . $b . $c); | |
2764 | $d = !$a . $b . $c; | |
2765 | $a = $b . $c . ($a . $b); | |
2766 | $e = f($d = !$a . $b) . $c; | |
2767 | $d = "${a}x\x{100}$b$c"; | |
2768 | f($d = !$a . $b . $c); | |
2769 | #### | |
2770 | # multiconcat with lexical my | |
2771 | my($a, $b, $c, $d, $e, @a); | |
2772 | my $d1 = 'foo' . $a; | |
2773 | my $d2 = "foo$a"; | |
2774 | my $d3 = $a . ''; | |
2775 | my $d4 = 'foo' . $a . 'bar'; | |
2776 | my $d5 = $a . $b; | |
2777 | my $d6 = $a . $b . $c; | |
2778 | my $e7 = ($d = $a . $b . $c); | |
2779 | my $d8 = !$a . $b . $c; | |
2780 | my $d9 = $b . $c . ($a . $b); | |
2781 | my $da = f($d = !$a . $b) . $c; | |
2782 | my $dc = "${a}x\x{100}$b$c"; | |
2783 | f(my $db = !$a . $b . $c); | |
2784 | my $dd = $a . $b . $c . @a; | |
2785 | #### | |
2786 | # multiconcat with lexical append | |
2787 | my($a, $b, $c, $d, $e, @a); | |
2788 | $d .= ''; | |
2789 | $d .= $a; | |
2790 | $d .= "$a"; | |
2791 | $d .= 'foo' . $a; | |
2792 | $d .= "foo$a"; | |
2793 | $d .= $a . ''; | |
2794 | $d .= 'foo' . $a . 'bar'; | |
2795 | $d .= $a . $b; | |
2796 | $d .= $a . $b . $c; | |
2797 | $d .= $a . $b . @a; | |
2798 | $e .= ($d = $a . $b . $c); | |
2799 | $d .= !$a . $b . $c; | |
2800 | $a .= $b . $c . ($a . $b); | |
2801 | $e .= f($d .= !$a . $b) . $c; | |
2802 | f($d .= !$a . $b . $c); | |
2803 | $d .= "${a}x\x{100}$b$c"; | |
2804 | #### | |
2805 | # multiconcat with expression assign | |
2806 | my($a, $b, $c, @a); | |
2807 | our($d, $e); | |
2808 | $d = 'foo' . $a; | |
2809 | $d = "foo$a"; | |
2810 | $d = $a . ''; | |
2811 | $d = 'foo' . $a . 'bar'; | |
2812 | $d = $a . $b; | |
2813 | $d = $a . $b . $c; | |
2814 | $d = $a . $b . @a; | |
2815 | $e = ($d = $a . $b . $c); | |
2816 | $a["-$b-"] = !$a . $b . $c; | |
2817 | $a[$b]{$c}{$d ? $a : $b . $c} = !$a . $b . $c; | |
2818 | $a = $b . $c . ($a . $b); | |
2819 | $e = f($d = !$a . $b) . $c; | |
2820 | $d = "${a}x\x{100}$b$c"; | |
2821 | f($d = !$a . $b . $c); | |
2822 | #### | |
2823 | # multiconcat with expression concat | |
2824 | my($a, $b, $c, @a); | |
2825 | our($d, $e); | |
2826 | $d .= 'foo' . $a; | |
2827 | $d .= "foo$a"; | |
2828 | $d .= $a . ''; | |
2829 | $d .= 'foo' . $a . 'bar'; | |
2830 | $d .= $a . $b; | |
2831 | $d .= $a . $b . $c; | |
2832 | $d .= $a . $b . @a; | |
2833 | $e .= ($d .= $a . $b . $c); | |
2834 | $a["-$b-"] .= !$a . $b . $c; | |
2835 | $a[$b]{$c}{$d ? $a : $b . $c} .= !$a . $b . $c; | |
2836 | $a .= $b . $c . ($a . $b); | |
2837 | $e .= f($d .= !$a . $b) . $c; | |
2838 | $d .= "${a}x\x{100}$b$c"; | |
2839 | f($d .= !$a . $b . $c); | |
2840 | #### | |
2841 | # multiconcat with CORE::sprintf | |
2842 | # CONTEXT sub sprintf {} | |
2843 | my($a, $b); | |
2844 | my $x = CORE::sprintf('%s%s', $a, $b); | |
2845 | #### | |
2846 | # multiconcat with backticks | |
2847 | my($a, $b); | |
2848 | our $x; | |
2849 | $x = `$a-$b`; | |
2850 | #### | |
2851 | # multiconcat within qr// | |
2852 | my($r, $a, $b); | |
2853 | $r = qr/abc\Q$a-$b\Exyz/; | |
b4fb15a6 JL |
2854 | #### |
2855 | # tr with unprintable characters | |
2856 | my $str; | |
2857 | $str = 'foo'; | |
2858 | $str =~ tr/\cA//; | |
e923f3dc Z |
2859 | #### |
2860 | # CORE::foo special case in bareword parsing | |
dd666160 Z |
2861 | print $CORE::foo, $CORE::foo::bar; |
2862 | print @CORE::foo, @CORE::foo::bar; | |
2863 | print %CORE::foo, %CORE::foo::bar; | |
2864 | print $CORE::foo{'a'}, $CORE::foo::bar{'a'}; | |
2865 | print &CORE::foo, &CORE::foo::bar; | |
2866 | print &CORE::foo(), &CORE::foo::bar(); | |
2867 | print *CORE::foo, *CORE::foo::bar; | |
2868 | print stat CORE::foo::, stat CORE::foo::bar; | |
2869 | print CORE::foo:: 1; | |
2870 | print CORE::foo::bar 2; | |
2871 | #### | |
2872 | # trailing colons on glob names | |
2873 | no strict 'vars'; | |
2874 | $Foo::::baz = 1; | |
2875 | print $foo, $foo::, $foo::::; | |
2876 | print @foo, @foo::, @foo::::; | |
2877 | print %foo, %foo::, %foo::::; | |
2878 | print $foo{'a'}, $foo::{'a'}, $foo::::{'a'}; | |
2879 | print &foo, &foo::, &foo::::; | |
2880 | print &foo(), &foo::(), &foo::::(); | |
2881 | print *foo, *foo::, *foo::::; | |
2882 | print stat Foo, stat Foo::::; | |
2883 | print Foo 1; | |
2884 | print Foo:::: 2; | |
2885 | #### | |
2886 | # trailing colons mixed with CORE | |
2887 | no strict 'vars'; | |
2888 | print $CORE, $CORE::, $CORE::::; | |
2889 | print @CORE, @CORE::, @CORE::::; | |
2890 | print %CORE, %CORE::, %CORE::::; | |
2891 | print $CORE{'a'}, $CORE::{'a'}, $CORE::::{'a'}; | |
2892 | print &CORE, &CORE::, &CORE::::; | |
2893 | print &CORE(), &CORE::(), &CORE::::(); | |
2894 | print *CORE, *CORE::, *CORE::::; | |
2895 | print stat CORE, stat CORE::::; | |
2896 | print CORE 1; | |
2897 | print CORE:::: 2; | |
2898 | print $CORE::foo, $CORE::foo::, $CORE::foo::::; | |
2899 | print @CORE::foo, @CORE::foo::, @CORE::foo::::; | |
2900 | print %CORE::foo, %CORE::foo::, %CORE::foo::::; | |
2901 | print $CORE::foo{'a'}, $CORE::foo::{'a'}, $CORE::foo::::{'a'}; | |
2902 | print &CORE::foo, &CORE::foo::, &CORE::foo::::; | |
2903 | print &CORE::foo(), &CORE::foo::(), &CORE::foo::::(); | |
2904 | print *CORE::foo, *CORE::foo::, *CORE::foo::::; | |
2905 | print stat CORE::foo::, stat CORE::foo::::; | |
2906 | print CORE::foo:: 1; | |
2907 | print CORE::foo:::: 2; |