Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
9b7d3fdf | 3 | print "1..117\n"; |
8d063cd8 | 4 | |
79072805 | 5 | $x = 'x'; |
8d063cd8 | 6 | |
79072805 LW |
7 | print "#1 :$x: eq :x:\n"; |
8 | if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";} | |
8d063cd8 | 9 | |
1a9b3510 | 10 | $x = $#[0]; |
8d063cd8 LW |
11 | |
12 | if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";} | |
13 | ||
14 | $x = $#x; | |
15 | ||
16 | if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";} | |
17 | ||
18 | $x = '\\'; # '; | |
19 | ||
20 | if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";} | |
a559c259 LW |
21 | |
22 | eval 'while (0) { | |
23 | print "foo\n"; | |
24 | } | |
25 | /^/ && (print "ok 5\n"); | |
26 | '; | |
27 | ||
28 | eval '$foo{1} / 1;'; | |
79072805 | 29 | if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";} |
378cc40b LW |
30 | |
31 | eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;'; | |
32 | ||
33 | $foo = int($foo * 100 + .5); | |
87250799 | 34 | if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";} |
a687059c LW |
35 | |
36 | print <<'EOF'; | |
37 | ok 8 | |
38 | EOF | |
39 | ||
40 | $foo = 'ok 9'; | |
41 | print <<EOF; | |
42 | $foo | |
43 | EOF | |
44 | ||
45 | eval <<\EOE, print $@; | |
46 | print <<'EOF'; | |
47 | ok 10 | |
48 | EOF | |
49 | ||
50 | $foo = 'ok 11'; | |
51 | print <<EOF; | |
52 | $foo | |
53 | EOF | |
54 | EOE | |
55 | ||
972e7321 MS |
56 | print <<'EOS' . <<\EOF; |
57 | ok 12 - make sure single quotes are honored \nnot ok | |
a687059c LW |
58 | EOS |
59 | ok 13 | |
60 | EOF | |
61 | ||
62 | print qq/ok 14\n/; | |
63 | print qq(ok 15\n); | |
64 | ||
65 | print qq | |
a0d0e21e | 66 | [ok 16\n] |
a687059c LW |
67 | ; |
68 | ||
69 | print q<ok 17 | |
70 | >; | |
71 | ||
f3365a56 NC |
72 | print "ok 18 - was the test for the deprecated use of bare << to mean <<\"\"\n"; |
73 | #print <<; # Yow! | |
74 | #ok 18 | |
75 | # | |
76 | ## previous line intentionally left blank. | |
79072805 | 77 | |
2ba53c57 HS |
78 | print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n"; |
79 | @{[ <<E2 ]} | |
80 | foo | |
81 | E2 | |
82 | E1 | |
83 | ||
84 | print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n"; | |
85 | @{[ | |
86 | <<E2 | |
87 | foo | |
88 | E2 | |
89 | ]} | |
90 | E1 | |
91 | ||
79072805 LW |
92 | $foo = FOO; |
93 | $bar = BAR; | |
94 | $foo{$bar} = BAZ; | |
95 | $ary[0] = ABC; | |
96 | ||
2ba53c57 | 97 | print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n"; |
79072805 | 98 | |
2ba53c57 HS |
99 | print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n"; |
100 | print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n"; | |
79072805 | 101 | |
2ba53c57 HS |
102 | print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n"; |
103 | print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n"; | |
104 | print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n"; | |
1bcde0ca | 105 | |
f27ffc4a GS |
106 | # MJD 19980425 |
107 | ($X, @X) = qw(a b c d); | |
108 | print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n"; | |
109 | print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n"; | |
a2c06652 | 110 | |
f27ffc4a GS |
111 | print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n"); |
112 | ||
113 | ||
114 | $foo = "not ok 30\n"; | |
a2c06652 HS |
115 | $foo =~ s/^not /substr(<<EOF, 0, 0)/e; |
116 | Ignored | |
117 | EOF | |
118 | print $foo; | |
2b92dfce GS |
119 | |
120 | # Tests for new extended control-character variables | |
121 | # MJD 19990227 | |
122 | ||
6a4ad6ad BF |
123 | my $test = 31; |
124 | ||
2b92dfce GS |
125 | { my $CX = "\cX"; |
126 | my $CXY ="\cXY"; | |
127 | $ {$CX} = 17; | |
128 | $ {$CXY} = 23; | |
129 | if ($ {^XY} != 23) { print "not " } | |
6a4ad6ad | 130 | print "ok $test\n"; $test++; |
2b92dfce | 131 | |
2b92dfce GS |
132 | # Does the old UNBRACED syntax still do what it used to? |
133 | if ("$^XY" ne "17Y") { print "not " } | |
6a4ad6ad | 134 | print "ok $test\n"; $test++; |
2b92dfce GS |
135 | |
136 | sub XX () { 6 } | |
766c8ce8 JH |
137 | $ {"\cQ\cXX"} = 119; |
138 | $^Q = 5; # This should be an unused ^Var. | |
2b92dfce GS |
139 | $N = 5; |
140 | # The second caret here should be interpreted as an xor | |
766c8ce8 | 141 | if (($^Q^XX) != 3) { print "not " } |
6a4ad6ad | 142 | print "ok $test\n"; $test++; |
2b92dfce GS |
143 | |
144 | # These next two tests are trying to make sure that | |
15a8c21e | 145 | # $^FOO is always global; it doesn't make sense to 'my' it. |
2b92dfce | 146 | # |
0244c3a4 | 147 | |
2b92dfce GS |
148 | eval 'my $^X;'; |
149 | print "not " unless index ($@, 'Can\'t use global $^X in "my"') > -1; | |
6a4ad6ad | 150 | print "ok $test\n"; $test++; |
2b92dfce GS |
151 | # print "($@)\n" if $@; |
152 | ||
153 | eval 'my $ {^XYZ};'; | |
154 | print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1; | |
6a4ad6ad | 155 | print "ok $test\n"; $test++; |
2b92dfce | 156 | # print "($@)\n" if $@; |
4f08ed80 YO |
157 | # |
158 | ${^TEST}= "splat"; | |
159 | @{^TEST}= ("foo", "bar"); | |
160 | %{^TEST}= ("foo" => "FOO", "bar" => "BAR" ); | |
9b7d3fdf | 161 | |
4f08ed80 YO |
162 | print "not " if "${^TEST}" ne "splat"; |
163 | print "ok $test\n"; $test++; | |
9b7d3fdf YO |
164 | |
165 | print "not " if "${ ^TEST }" ne "splat"; | |
166 | print "ok $test\n"; $test++; | |
4f08ed80 YO |
167 | |
168 | print "not " if "${^TEST}[0]" ne "splat[0]"; | |
169 | print "ok $test\n"; $test++; | |
170 | ||
171 | print "not " if "${^TEST[0]}" ne "foo"; | |
172 | print "ok $test\n"; $test++; | |
173 | ||
174 | print "not " if "${ ^TEST [1] }" ne "bar"; | |
175 | print "ok $test\n"; $test++; | |
176 | ||
177 | print "not " if "${^TEST}{foo}" ne "splat{foo}"; | |
178 | print "ok $test\n"; $test++; | |
179 | ||
180 | print "not " if "${^TEST{foo}}" ne "FOO"; | |
181 | print "ok $test\n"; $test++; | |
182 | ||
183 | print "not " if "${ ^TEST {bar} }" ne "BAR"; | |
184 | print "ok $test\n"; $test++; | |
185 | ||
2b92dfce GS |
186 | |
187 | # Now let's make sure that caret variables are all forced into the main package. | |
188 | package Someother; | |
766c8ce8 JH |
189 | $^Q = 'Someother'; |
190 | $ {^Quixote} = 'Someother 2'; | |
2b92dfce GS |
191 | $ {^M} = 'Someother 3'; |
192 | package main; | |
766c8ce8 | 193 | print "not " unless $^Q eq 'Someother'; |
6a4ad6ad | 194 | print "ok $test\n"; $test++; |
766c8ce8 | 195 | print "not " unless $ {^Quixote} eq 'Someother 2'; |
6a4ad6ad | 196 | print "ok $test\n"; $test++; |
2b92dfce | 197 | print "not " unless $ {^M} eq 'Someother 3'; |
6a4ad6ad | 198 | print "ok $test\n"; $test++; |
2b92dfce GS |
199 | |
200 | ||
201 | } | |
202 | ||
0244c3a4 | 203 | # see if eval '', s///e, and heredocs mix |
2b92dfce | 204 | |
0244c3a4 GS |
205 | sub T { |
206 | my ($where, $num) = @_; | |
207 | my ($p,$f,$l) = caller; | |
208 | print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/; | |
209 | print "ok $num\n"; | |
210 | } | |
211 | ||
0244c3a4 GS |
212 | { |
213 | # line 42 "plink" | |
214 | local $_ = "not ok "; | |
215 | eval q{ | |
216 | s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++; | |
7d66e4bd | 217 | # uggedaboudit |
0244c3a4 GS |
218 | EOT |
219 | print $_, $test++, "\n"; | |
220 | T('^main:\(eval \d+\):6$', $test++); | |
221 | # line 1 "plunk" | |
222 | T('^main:plunk:1$', $test++); | |
223 | }; | |
224 | print "# $@\nnot ok $test\n" if $@; | |
225 | T '^main:plink:53$', $test++; | |
226 | } | |
8593bda5 GS |
227 | |
228 | # tests 47--51 start here | |
229 | # tests for new array interpolation semantics: | |
230 | # arrays now *always* interpolate into "..." strings. | |
231 | # 20000522 MJD (mjd@plover.com) | |
232 | { | |
8593bda5 GS |
233 | eval(q(">@nosuch<" eq "><")) || print "# $@", "not "; |
234 | print "ok $test\n"; | |
235 | ++$test; | |
236 | ||
237 | # Look at this! This is going to be a common error in the future: | |
238 | eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not "; | |
239 | print "ok $test\n"; | |
240 | ++$test; | |
241 | ||
242 | # Let's make sure that normal array interpolation still works right | |
243 | # For some reason, this appears not to be tested anywhere else. | |
244 | my @a = (1,2,3); | |
245 | print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n"; | |
246 | ++$test; | |
247 | ||
248 | # Ditto. | |
249 | eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"}) | |
250 | || print "# $@", "not "; | |
251 | print "ok $test\n"; | |
252 | ++$test; | |
253 | ||
254 | # This isn't actually a lex test, but it's testing the same feature | |
255 | sub makearray { | |
256 | my @array = ('fish', 'dog', 'carrot'); | |
257 | *R::crackers = \@array; | |
258 | } | |
259 | ||
260 | eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"}) | |
261 | || print "# $@", "not "; | |
262 | print "ok $test\n"; | |
263 | ++$test; | |
264 | } | |
ce29ac45 JH |
265 | |
266 | # Tests 52-54 | |
267 | # => should only quote foo::bar if it isn't a real sub. AMS, 20010621 | |
268 | ||
269 | sub xyz::foo { "bar" } | |
270 | my %str = ( | |
271 | foo => 1, | |
272 | xyz::foo => 1, | |
273 | xyz::bar => 1, | |
274 | ); | |
275 | ||
ce29ac45 JH |
276 | print ((exists $str{foo} ? "" : "not ")."ok $test\n"); ++$test; |
277 | print ((exists $str{bar} ? "" : "not ")."ok $test\n"); ++$test; | |
278 | print ((exists $str{xyz::bar} ? "" : "not ")."ok $test\n"); ++$test; | |
62444305 AE |
279 | |
280 | sub foo::::::bar { print "ok $test\n"; $test++ } | |
281 | foo::::::bar; | |
356c7adf | 282 | |
6345b1dc KW |
283 | # \xDF is a non-ASCII alpha on both ASCII and EBCDIC. |
284 | eval "\$x =\xDFfoo"; | |
285 | if ($@ =~ /Unrecognized character \\xDF; marked by <-- HERE after \$x =<-- HERE near column 5/) { print "ok $test\n"; } else { print "not ok $test\n"; } | |
356c7adf | 286 | $test++; |
df3467db IG |
287 | |
288 | # Is "[~" scanned correctly? | |
f50fa36f IG |
289 | @a = (1,2,3); |
290 | print "not " unless($a[~~2] == 3); | |
6a4ad6ad | 291 | print "ok $test\n"; $test++; |
565b52df FC |
292 | |
293 | $_ = ""; | |
6a4ad6ad BF |
294 | eval 's/(?:)/"ok $test" . "${\q||}".<<\END/e; |
295 | - heredoc after "" in s/// in eval | |
565b52df FC |
296 | END |
297 | '; | |
6a4ad6ad | 298 | print $_ || "not ok $test\n"; $test++; |
043cc6c6 FC |
299 | |
300 | $_ = ""; | |
6a4ad6ad BF |
301 | eval 's|(?:)|"ok $test" . "${\<<\END}" |
302 | - heredoc in "" in multiline s///e in eval | |
043cc6c6 FC |
303 | END |
304 | |e | |
305 | '; | |
6a4ad6ad | 306 | print $_ || "not ok $test\n"; $test++; |
62abd0d7 FC |
307 | |
308 | $_ = ""; | |
309 | eval "s/(?:)/<<foo/e #\0 | |
6a4ad6ad | 310 | ok $test - null on same line as heredoc in s/// in eval |
62abd0d7 FC |
311 | foo |
312 | "; | |
6a4ad6ad | 313 | print $_ || "not ok $test\n"; $test++; |
99bd9d90 FC |
314 | |
315 | $_ = ""; | |
316 | eval ' s/(?:)/"${\<<END}"/e; | |
6a4ad6ad | 317 | ok $test - heredoc in "" in single-line s///e in eval |
99bd9d90 FC |
318 | END |
319 | '; | |
6a4ad6ad | 320 | print $_ || "not ok $test\n"; $test++; |
99bd9d90 FC |
321 | |
322 | $_ = ""; | |
323 | s|(?:)|"${\<<END}" | |
6a4ad6ad | 324 | ok $test - heredoc in "" in multiline s///e outside eval |
99bd9d90 FC |
325 | END |
326 | |e; | |
6a4ad6ad | 327 | print $_ || "not ok $test\n"; $test++; |
7cc34111 | 328 | |
6a4ad6ad | 329 | $_ = "not ok $test - s/// in s/// pattern\n"; |
7cc34111 | 330 | s/${s|||;\""}not //; |
6a4ad6ad | 331 | print; $test++; |
db444266 FC |
332 | |
333 | /(?{print <<END | |
6a4ad6ad | 334 | ok $test - here-doc in re-eval |
db444266 | 335 | END |
6a4ad6ad | 336 | })/; $test++; |
db444266 FC |
337 | |
338 | eval '/(?{print <<END | |
6a4ad6ad | 339 | ok $test - here-doc in re-eval in string eval |
db444266 | 340 | END |
6a4ad6ad | 341 | })/'; $test++; |
11076590 | 342 | |
6a4ad6ad BF |
343 | eval 'print qq ;ok $test - eval ending with semicolon\n;' |
344 | or print "not ok $test - eval ending with semicolon\n"; $test++; | |
3328ab5a FC |
345 | |
346 | print "not " unless qr/(?{<<END})/ eq '(?^:(?{<<END}))'; | |
347 | foo | |
348 | END | |
6a4ad6ad | 349 | print "ok $test - here-doc in single-line re-eval\n"; $test++; |
3328ab5a FC |
350 | |
351 | $_ = qr/(?{"${<<END}" | |
352 | foo | |
353 | END | |
354 | })/; | |
355 | print "not " unless /foo/; | |
6a4ad6ad | 356 | print "ok $test - here-doc in quotes in multiline re-eval\n"; $test++; |
76f9939e FC |
357 | |
358 | eval 's//<<END/e if 0; $_ = "a | |
359 | END | |
360 | b"'; | |
361 | print "not " if $_ =~ /\n\n/; | |
6a4ad6ad | 362 | print "ok $test - eval 's//<<END/' does not leave extra newlines\n"; $test++; |
9c74ccc9 FC |
363 | |
364 | $_ = a; | |
365 | eval "s/a/'b\0'#/e"; | |
366 | print 'not ' unless $_ eq "b\0"; | |
6a4ad6ad | 367 | print "ok $test - # after null in s/// repl\n"; $test++; |
9c74ccc9 FC |
368 | |
369 | s//"#" . <<END/e; | |
370 | foo | |
371 | END | |
6a4ad6ad | 372 | print "ok $test - s//'#' . <<END/e\n"; $test++; |
6b00f562 FC |
373 | |
374 | eval "s//3}->{3/e"; | |
375 | print "not " unless $@; | |
6a4ad6ad | 376 | print "ok $test - s//3}->{3/e\n"; $test++; |
f777953f | 377 | |
6a4ad6ad | 378 | $_ = "not ok $test"; |
f777953f FC |
379 | $x{3} = "not "; |
380 | eval 's/${\%x}{3}//e'; | |
6a4ad6ad | 381 | print "$_ - s//\${\\%x}{3}/e\n"; $test++; |
90a536e1 FC |
382 | |
383 | eval 's/${foo#}//e'; | |
384 | print "not " unless $@; | |
6a4ad6ad | 385 | print "ok $test - s/\${foo#}//e\n"; $test++; |
819b004e FC |
386 | |
387 | eval 'warn ({$_ => 1} + 1) if 0'; | |
388 | print "not " if $@; | |
6a4ad6ad | 389 | print "ok $test - listop({$_ => 1} + 1)\n"; $test++; |
819b004e | 390 | print "# $@" if $@; |
c31f6d3b | 391 | |
29c312f9 | 392 | for(qw< require goto last next redo CORE::dump >) { |
c31f6d3b FC |
393 | eval "sub { $_ foo << 2 }"; |
394 | print "not " if $@; | |
395 | print "ok ", $test++, " - [perl #105924] $_ WORD << ...\n"; | |
396 | print "# $@" if $@; | |
397 | } | |
e9d2327d FC |
398 | |
399 | # http://rt.perl.org/rt3/Ticket/Display.html?id=56880 | |
400 | my $counter = 0; | |
401 | eval 'v23: $counter++; goto v23 unless $counter == 2'; | |
402 | print "not " unless $counter == 2; | |
6a4ad6ad | 403 | print "ok $test - Use v[0-9]+ as a label\n"; $test++; |
e9d2327d FC |
404 | $counter = 0; |
405 | eval 'v23 : $counter++; goto v23 unless $counter == 2'; | |
406 | print "not " unless $counter == 2; | |
6a4ad6ad | 407 | print "ok $test - Use v[0-9]+ as a label with space before colon\n"; $test++; |
e9d2327d FC |
408 | |
409 | my $output = ""; | |
410 | eval "package v10::foo; sub test2 { return 'v10::foo' } | |
411 | package v10; sub test { return v10::foo::test2(); } | |
412 | package main; \$output = v10::test(); "; | |
413 | print "not " unless $output eq 'v10::foo'; | |
6a4ad6ad | 414 | print "ok $test - call a function in package v10::foo\n"; $test++; |
e9d2327d | 415 | |
6345b1dc | 416 | print "not " unless (1?v65:"bar") eq chr(65); |
6a4ad6ad | 417 | print "ok $test - colon detection after vstring does not break ? vstring :\n"; $test++; |
770ed452 KW |
418 | |
419 | print ((ord("A") == 65) ? v35 : v123); # NUMBER SIGN is the same for all | |
420 | # supported EBCDIC platforms | |
421 | print "not "; | |
422 | print ((ord("A") == 65) ? v10 : "\n"); # LF varies on EBCDIC, if the v123 for | |
423 | # '#' works above, consider it good | |
424 | # enough. | |
a9d49ba7 | 425 | print "ok $test - print vstring prints the vstring\n"; |
a9d49ba7 | 426 | $test++; |
8b12970a FC |
427 | |
428 | # Test pyoq ops with comments before the first delim | |
429 | q # comment | |
430 | "b"# | |
431 | eq 'b' or print "not "; | |
6a4ad6ad | 432 | print "ok $test - q <comment> <newline> ...\n"; $test++; |
8b12970a FC |
433 | qq # comment |
434 | "b"# | |
435 | eq 'b' or print "not "; | |
6a4ad6ad | 436 | print "ok $test - qq <comment> <newline> ...\n"; $test++; |
8b12970a FC |
437 | qw # comment |
438 | "b"# | |
439 | [0] eq 'b' or print "not "; | |
6a4ad6ad | 440 | print "ok $test - qw <comment> <newline> ...\n"; $test++; |
8b12970a FC |
441 | "b" =~ m # comment |
442 | "b"# | |
443 | or print "not "; | |
6a4ad6ad | 444 | print "ok $test - m <comment> <newline> ...\n"; $test++; |
8b12970a FC |
445 | qr # comment |
446 | "b"# | |
447 | eq qr/b/ or print "not "; | |
6a4ad6ad | 448 | print "ok $test - qr <comment> <newline> ...\n"; $test++; |
8b12970a FC |
449 | $_ = "a"; |
450 | s # comment | |
451 | [a] # | |
452 | [b] # | |
453 | ; | |
454 | print "not " unless $_ eq 'b'; | |
6a4ad6ad | 455 | print "ok $test - s <comment> <newline> ...\n"; $test++; |
8b12970a FC |
456 | $_ = "a"; |
457 | tr # comment | |
458 | [a] # | |
459 | [b] # | |
460 | ; | |
461 | print "not " unless $_ eq 'b'; | |
6a4ad6ad | 462 | print "ok $test - tr <comment> <newline> ...\n"; $test++; |
8b12970a FC |
463 | $_ = "a"; |
464 | y # comment | |
465 | [a] # | |
466 | [b] # | |
467 | ; | |
468 | print "not " unless $_ eq 'b'; | |
6a4ad6ad | 469 | print "ok $test - y <comment> <newline> ...\n"; $test++; |
21791330 FC |
470 | |
471 | print "not " unless (time | |
472 | =>) eq time=>; | |
6a4ad6ad | 473 | print "ok $test - => quotes keywords across lines\n"; $test++; |
e4916dd1 FC |
474 | |
475 | # [perl #80368] | |
476 | print "not " unless eval '"a\U="' eq "a="; | |
477 | print "ok $test - [perl #80368] qq <a\\U=>\n"; $test++; | |
8380b690 FC |
478 | |
479 | sub Function_with_side_effects { $_ = "sidekick function called" } | |
480 | print "not " unless | |
481 | (eval '${Function_with_side_effects,\$_}' || $@) | |
482 | eq "sidekick function called"; | |
483 | print "ok $test - \${...} where {...} looks like hash\n"; $test++; | |
e660c409 FC |
484 | |
485 | @_ = map{BEGIN {$_122782 = 'tst2'}; "rhu$_"} 'barb2'; | |
486 | print "not " unless "@_" eq 'rhubarb2'; | |
487 | print "ok $test - map{BEGIN...\n"; $test++; | |
488 | print "not " unless $_122782 eq 'tst2'; | |
489 | print "ok $test - map{BEGIN...\n"; $test++; | |
490 | ${ | |
491 | =pod | |
492 | blah blah blah | |
493 | =cut | |
494 | \$_ } = 42; | |
495 | print "not "unless $_ == 42; | |
496 | print "ok $test - \${ <newline> =pod\n"; $test++; | |
497 | @_ = map{ | |
498 | =pod | |
499 | blah blah blah | |
500 | =cut | |
501 | $_+1 } 1; | |
502 | print "not "unless "@_" eq 2; | |
503 | print "ok $test - map{ <newline> =pod\n"; $test++; | |
504 | eval { ${...}++ }; | |
505 | print "not " unless $@ =~ /^Unimplemented at /; | |
506 | print "ok $test - \${...} (literal triple-dot)\n"; $test++; | |
507 | eval { () = map{...} @_ }; | |
508 | print "not " unless $@ =~ /^Unimplemented at /; | |
509 | print "ok $test - map{...} (literal triple-dot)\n"; $test++; | |
510 | print "not " unless &{sub :lvalue { "a" }} eq "a"; | |
511 | print "ok $test - &{sub :lvalue...}\n"; $test++; | |
712a4517 | 512 | print "not " unless ref +(map{sub :lvalue { "a" }} 1)[0] eq "CODE"; |
e660c409 | 513 | print "ok $test - map{sub :lvalue...}\n"; $test++; |
83a85f49 FC |
514 | |
515 | # Used to crash [perl #123711] | |
516 | 0-5x-l{0}; | |
eabab8bc | 517 | |
ce7c414e | 518 | # Used to fail an assertion [perl #123617] [perl #123955] |
eabab8bc | 519 | eval '"$a{ 1 m// }"; //'; |
ce7c414e | 520 | eval '"@0{0s 000";eval"$"'; |
7aa8cb0d FC |
521 | |
522 | # Pending token stack overflow [perl #123677] | |
523 | { | |
524 | local $SIG{__WARN__}=sub{}; | |
525 | eval q|s)$0{0h());qx(@0);qx(@0);qx(@0)|; | |
526 | } | |
f4460c6f FC |
527 | |
528 | # Used to crash [perl #123801] | |
529 | eval q|s##[}#e|; | |
179b3fad FC |
530 | |
531 | # Used to fail an assertion [perl #123763] | |
532 | { | |
533 | local $SIG{__WARN__}=sub{}; | |
534 | eval q|my($_);0=split|; | |
55b39803 | 535 | eval q|my $_; @x = split|; |
179b3fad | 536 | } |
b12396ac TC |
537 | |
538 | { | |
539 | # Used to crash [perl #124187] | |
540 | eval q|qq{@{[{}}*sub{]]}}}=u|; | |
541 | } | |
de0885da DM |
542 | |
543 | { | |
544 | # Used to crash [perl #124385] | |
545 | eval '0; qq{@{sub{]]}}}}}'; | |
546 | print "ok $test - 124385\n"; $test++; | |
547 | } | |
a293d0fd SF |
548 | |
549 | { | |
550 | # Used to crash [perl #125350] | |
551 | eval ('qq{@{[0}*sub{]]}}}=sub{0' . "\c["); | |
552 | print "ok $test - 125350\n"; $test++; | |
553 | } | |
d6744494 FC |
554 | |
555 | { | |
556 | # Used to crash [perl #128171] | |
557 | eval ('/@0{0*->@*/*]'); | |
558 | print "ok $test - 128171\n"; $test++; | |
559 | } | |
d9d2b74c FC |
560 | |
561 | $foo = "WRONG"; $foo:: = "bar"; $bar = "baz"; | |
562 | print "not " unless "$foo::$bar" eq "barbaz"; | |
563 | print qq|ok $test - [perl #128478] "\$foo::\$bar"\n|; $test++; | |
564 | @bar = ("baz","bonk"); | |
565 | print "not " unless "$foo::@bar" eq "barbaz bonk"; | |
566 | print qq|ok $test - [perl #128478] "\$foo::\@bar"\n|; $test ++; | |
9dcfb888 FC |
567 | |
568 | # Test that compilation of tentative indirect method call syntax which | |
569 | # turns out not to be such does not upgrade constants to full globs in the | |
570 | # symbol table. | |
571 | sub fop() { 0 } | |
572 | sub bas() { 0 } | |
573 | { local $SIG{__WARN__}=sub{}; eval 'fop bas'; } | |
574 | print "not " unless ref $::{fop} eq 'SCALAR'; | |
575 | print "ok $test - first constant in 'const1 const2' is not upgraded\n"; | |
576 | $test++; | |
577 | print "not " unless ref $::{bas} eq 'SCALAR'; | |
578 | print "ok $test - second constant in 'const1 const2' is not upgraded\n"; | |
579 | $test++; |