This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Misc microoptimizations when dealing with new SVs
[perl5.git] / t / comp / parser.t
CommitLineData
923be969
RGS
1#!./perl
2
3# Checks if the parser behaves correctly in edge cases
4# (including weird syntax errors)
5
561e8675
CB
6BEGIN {
7 @INC = qw(. ../lib);
a817e89d 8 chdir 't' if -d 't';
561e8675
CB
9}
10
bd09be5b 11print "1..191\n";
c9786f60
NC
12
13sub failed {
14 my ($got, $expected, $name) = @_;
15
16 print "not ok $test - $name\n";
17 my @caller = caller(1);
18 print "# Failed test at $caller[1] line $caller[2]\n";
19 if (defined $got) {
20 print "# Got '$got'\n";
21 } else {
22 print "# Got undef\n";
23 }
24 print "# Expected $expected\n";
25 return;
923be969
RGS
26}
27
c9786f60
NC
28sub like {
29 my ($got, $pattern, $name) = @_;
30 $test = $test + 1;
31 if (defined $got && $got =~ $pattern) {
32 print "ok $test - $name\n";
33 # Principle of least surprise - maintain the expected interface, even
34 # though we aren't using it here (yet).
35 return 1;
36 }
37 failed($got, $pattern, $name);
38}
39
40sub is {
41 my ($got, $expect, $name) = @_;
42 $test = $test + 1;
43 if (defined $expect) {
44 if (defined $got && $got eq $expect) {
45 print "ok $test - $name\n";
46 return 1;
47 }
48 failed($got, "'$expect'", $name);
49 } else {
50 if (!defined $got) {
51 print "ok $test - $name\n";
52 return 1;
53 }
54 failed($got, 'undef', $name);
55 }
56}
f15b33d3
RGS
57
58eval '%@x=0;';
59like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
60
ee95e30c 61# Bug 20010422.005 (#6874)
f15b33d3
RGS
62eval q{{s//${}/; //}};
63like( $@, qr/syntax error/, 'syntax error, used to dump core' );
64
ee95e30c 65# Bug 20010528.007 (#7052)
f15b33d3
RGS
66eval q/"\x{"/;
67like( $@, qr/^Missing right brace on \\x/,
68 'syntax error in string, used to dump core' );
69
fd7808cb
RGS
70eval q/"\N{"/;
71like( $@, qr/^Missing right brace on \\N/,
72 'syntax error in string with incomplete \N' );
73eval q/"\Nfoo"/;
74like( $@, qr/^Missing braces on \\N/,
75 'syntax error in string with incomplete \N' );
76
ae9ce25e
KW
77eval q/"\o{"/;
78like( $@, qr/^Missing right brace on \\o/,
79 'syntax error in string with incomplete \o' );
80eval q/"\ofoo"/;
81like( $@, qr/^Missing braces on \\o/,
82 'syntax error in string with incomplete \o' );
83
f15b33d3
RGS
84eval "a.b.c.d.e.f;sub";
85like( $@, qr/^Illegal declaration of anonymous subroutine/,
86 'found by Markov chain stress testing' );
87
ee95e30c 88# Bug 20010831.001 (#7605)
f15b33d3
RGS
89eval '($a, b) = (1, 2);';
90like( $@, qr/^Can't modify constant item in list assignment/,
91 'bareword in list assignment' );
92
93eval 'tie FOO, "Foo";';
94like( $@, qr/^Can't modify constant item in tie /,
95 'tying a bareword causes a segfault in 5.6.1' );
96
97eval 'undef foo';
98like( $@, qr/^Can't modify constant item in undef operator /,
ee95e30c 99 'undefing constant causes a segfault in 5.6.1 [ID 20010906.019 (#7642)]' );
f15b33d3
RGS
100
101eval 'read($bla, FILE, 1);';
102like( $@, qr/^Can't modify constant item in read /,
ee95e30c 103 'read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054 (#7847)]' );
923be969
RGS
104
105# This used to dump core (bug #17920)
106eval q{ sub { sub { f1(f2();); my($a,$b,$c) } } };
f15b33d3 107like( $@, qr/error/, 'lexical block discarded by yacc' );
961ce445
RGS
108
109# bug #18573, used to corrupt memory
110eval q{ "\c" };
111like( $@, qr/^Missing control char name in \\c/, q("\c" string) );
8edd5f42 112
a40a317b
RGS
113eval q{ qq(foo$) };
114like( $@, qr/Final \$ should be \\\$ or \$name/, q($ at end of "" string) );
115
8edd5f42
RGS
116# two tests for memory corruption problems in the said variables
117# (used to dump core or produce strange results)
118
119is( "\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Qa", "a", "PL_lex_casestack" );
120
121eval {
122{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
123{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
124{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
125}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
126}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
127}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
128};
129is( $@, '', 'PL_lex_brackstack' );
437fd210
AE
130
131{
7df0d042
AE
132 # tests for bug #20716
133 undef $a;
134 undef @b;
135 my $a="A";
136 is("${a}{", "A{", "interpolation, qq//");
137 is("${a}[", "A[", "interpolation, qq//");
138 my @b=("B");
139 is("@{b}{", "B{", "interpolation, qq//");
2a53d331 140 is(qr/${a}\{/, '(?^:A\{)', "interpolation, qr//");
7df0d042 141 my $c = "A{";
2a53d331 142 $c =~ /${a}\{/;
7df0d042 143 is($&, 'A{', "interpolation, m//");
2a53d331 144 $c =~ s/${a}\{/foo/;
7df0d042
AE
145 is($c, 'foo', "interpolation, s/...//");
146 $c =~ s/foo/${a}{/;
147 is($c, 'A{', "interpolation, s//.../");
148 is(<<"${a}{", "A{ A[ B{\n", "interpolation, here doc");
149${a}{ ${a}[ @{b}{
150${a}{
437fd210 151}
4a202259 152
0f5d0394
AE
153eval q{ sub a(;; &) { } a { } };
154is($@, '', "';&' sub prototype confuses the lexer");
155
4a202259
AE
156# Bug #21575
157# ensure that the second print statement works, by playing a bit
158# with the test output.
159my %data = ( foo => "\n" );
160print "#";
161print(
162$data{foo});
c9786f60
NC
163$test = $test + 1;
164print "ok $test\n";
abc667d1
DM
165
166# Bug #21875
167# { q.* => ... } should be interpreted as hash, not block
168
169foreach my $line (split /\n/, <<'EOF')
1701 { foo => 'bar' }
1711 { qoo => 'bar' }
1721 { q => 'bar' }
1731 { qq => 'bar' }
1740 { q,'bar', }
1750 { q=bar= }
1760 { qq=bar= }
1771 { q=bar= => 'bar' }
178EOF
179{
180 my ($expect, $eval) = split / /, $line, 2;
181 my $result = eval $eval;
c9786f60 182 is($@, '', "eval $eval");
abc667d1
DM
183 is(ref $result, $expect ? 'HASH' : '', $eval);
184}
3cf7b4c4
RGS
185
186# Bug #24212
187{
188 local $SIG{__WARN__} = sub { }; # silence mandatory warning
189 eval q{ my $x = -F 1; };
250d67eb 190 like( $@, qr/(?i:syntax|parse) error .* near "F 1"/, "unknown filetest operators" );
3cf7b4c4
RGS
191 is(
192 eval q{ sub F { 42 } -F 1 },
193 '-42',
194 '-F calls the F function'
195 );
196}
1c03aa9b
RGS
197
198# Bug #24762
199{
200 eval q{ *foo{CODE} ? 1 : 0 };
201 is( $@, '', "glob subscript in conditional" );
202}
500bedb6
DM
203
204# Bug #25824
205{
206 eval q{ sub f { @a=@b=@c; {use} } };
207 like( $@, qr/syntax error/, "use without body" );
208}
e1548254 209
8e742a20
MHM
210# [perl #2738] perl segfautls on input
211{
212 eval q{ sub _ <> {} };
213 like($@, qr/Illegal declaration of subroutine main::_/, "readline operator as prototype");
214
215 eval q{ $s = sub <> {} };
216 like($@, qr/Illegal declaration of anonymous subroutine/, "readline operator as prototype");
217
218 eval q{ sub _ __FILE__ {} };
219 like($@, qr/Illegal declaration of subroutine main::_/, "__FILE__ as prototype");
220}
dbfe47cf 221
917949e3
RGS
222# tests for "Bad name"
223eval q{ foo::$bar };
224like( $@, qr/Bad name after foo::/, 'Bad name after foo::' );
225eval q{ foo''bar };
226like( $@, qr/Bad name after foo'/, 'Bad name after foo\'' );
a6a8bb49
RGS
227
228# test for ?: context error
229eval q{($a ? $x : ($y)) = 5};
230like( $@, qr/Assignment to both a list and a scalar/, 'Assignment to both a list and a scalar' );
2d997502
BC
231
232eval q{ s/x/#/e };
233is( $@, '', 'comments in s///e' );
2af555bf 234
718a7425 235# these five used to coredump because the op cleanup on parse error could
2af555bf
DM
236# be to the wrong pad
237
238eval q[
239 sub { our $a= 1;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;
240 sub { my $z
241];
242
243like($@, qr/Missing right curly/, 'nested sub syntax error' );
244
245eval q[
a5fba4f1 246 sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s);
2af555bf
DM
247 sub { my $z
248];
249like($@, qr/Missing right curly/, 'nested sub syntax error 2' );
250
718a7425
DM
251eval q[
252 sub { our $a= 1;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;$a;
253 use DieDieDie;
254];
255
256like($@, qr/Can't locate DieDieDie.pm/, 'croak cleanup' );
257
258eval q[
a5fba4f1 259 sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s);
718a7425
DM
260 use DieDieDie;
261];
262
263like($@, qr/Can't locate DieDieDie.pm/, 'croak cleanup 2' );
264
265
266eval q[
267 my @a;
a5fba4f1 268 my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s);
718a7425
DM
269 @a =~ s/a/b/; # compile-time error
270 use DieDieDie;
271];
272
273like($@, qr/Can't modify/, 'croak cleanup 3' );
274
7e5d8ed2
DM
275# these might leak, or have duplicate frees, depending on the bugginess of
276# the parser stack 'fail in reduce' cleanup code. They're here mainly as
277# something to be run under valgrind, with PERL_DESTRUCT_LEVEL=1.
278
279eval q[ BEGIN { } ] for 1..10;
280is($@, "", 'BEGIN 1' );
281
282eval q[ BEGIN { my $x; $x = 1 } ] for 1..10;
283is($@, "", 'BEGIN 2' );
284
285eval q[ BEGIN { \&foo1 } ] for 1..10;
286is($@, "", 'BEGIN 3' );
287
288eval q[ sub foo2 { } ] for 1..10;
289is($@, "", 'BEGIN 4' );
290
291eval q[ sub foo3 { my $x; $x=1 } ] for 1..10;
292is($@, "", 'BEGIN 5' );
293
294eval q[ BEGIN { die } ] for 1..10;
295like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 6' );
296
297eval q[ BEGIN {\&foo4; die } ] for 1..10;
298like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
44867030 299
0b3da58d
TC
300{
301 # RT #70934
302 # check both the specific case in the ticket, and a few other paths into
303 # S_scan_ident()
304 # simplify long ids
305 my $x100 = "x" x 256;
306 my $xFE = "x" x 254;
307 my $xFD = "x" x 253;
308 my $xFC = "x" x 252;
309 my $xFB = "x" x 251;
310
311 eval qq[ \$#$xFB ];
312 is($@, "", "251 character \$# sigil ident ok");
313 eval qq[ \$#$xFC ];
314 like($@, qr/Identifier too long/, "too long id in \$# sigil ctx");
315
316 eval qq[ \$$xFB ];
317 is($@, "", "251 character \$ sigil ident ok");
318 eval qq[ \$$xFC ];
319 like($@, qr/Identifier too long/, "too long id in \$ sigil ctx");
320
321 eval qq[ %$xFB ];
322 is($@, "", "251 character % sigil ident ok");
323 eval qq[ %$xFC ];
324 like($@, qr/Identifier too long/, "too long id in % sigil ctx");
325
c07656ed
FC
326 eval qq[ \\&$xFB ]; # take a ref since I don't want to call it
327 is($@, "", "251 character & sigil ident ok");
328 eval qq[ \\&$xFC ];
0b3da58d
TC
329 like($@, qr/Identifier too long/, "too long id in & sigil ctx");
330
331 eval qq[ *$xFC ];
332 is($@, "", "252 character glob ident ok");
333 eval qq[ *$xFD ];
334 like($@, qr/Identifier too long/, "too long id in glob ctx");
335
61bc2258 336 eval qq[ for $xFC ];
bd09be5b 337 like($@, qr/^Missing \$ on loop variable /,
61bc2258
H
338 "252 char id ok, but a different error");
339 eval qq[ for $xFD; ];
bd09be5b 340 like($@, qr/^Missing \$ on loop variable /, "too long id in for ctx");
0b3da58d
TC
341
342 # the specific case from the ticket
bd09be5b 343 # however the parsing code in yyl_foreach has now changed
0b3da58d
TC
344 my $x = "x" x 257;
345 eval qq[ for $x ];
bd09be5b
NC
346 like($@, qr/^Missing \$ on loop variable /, "too long id ticket case");
347
348 # as PL_tokenbuf is now PL_parser->tokenbuf, the "buffer overflow" that was
349 # reported in GH #9993 now corrupts some other part of the parser structure.
350 # Currently, that seems to be the line number. Hence this test will fail if
351 # the fix from commit 0b3da58dfdc35079 is reversed. (However, as the later
352 # commit 61bc22580524a6d9 changed the code (now) in yyl_foreach() from
353 # scan_ident() to scan_word(), to recreate the problem one needs to apply
354 # the buggy change to the calculation of the variable `e` in scan_word()
355 # instead.
356
357 my $x = "x" x 260;
358 eval qq[ for my $x \$foo ];
359 like($@, qr/at \(eval \d+\) line 1[,.]/, "line number is reported correctly");
0b3da58d
TC
360}
361
fd909433 362{
c9e0c59b 363 is(exists &zlonk, '', 'sub not present');
fd909433
VP
364 eval qq[ {sub zlonk} ];
365 is($@, '', 'sub declaration followed by a closing curly');
c9e0c59b
NC
366 is(exists &zlonk, 1, 'sub now stubbed');
367 is(defined &zlonk, '', 'but no body defined');
fd909433
VP
368}
369
ee36fb64
FC
370# [perl #113016] CORE::print::foo
371sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate
372sub CORE'foo'bar { 43 }
373is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo';
374is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error";
375
f0998909
Z
376# bug #71748
377eval q{
378 $_ = "";
379 s/(.)/
380 {
381 #
382 }->{$1};
383 /e;
384 1;
385};
386is($@, "", "multiline whitespace inside substitute expression");
387
a73ef99b
FC
388eval '@A =~ s/a/b/; # compilation error
389 sub tahi {}
390 sub rua;
391 sub toru ($);
392 sub wha :lvalue;
393 sub rima ($%&*$&*\$%\*&$%*&) :method;
394 sub ono :lvalue { die }
395 sub whitu (_) { die }
396 sub waru ($;) :method { die }
397 sub iwa { die }
398 BEGIN { }';
399is $::{tahi}, undef, 'empty sub decl ignored after compilation error';
400is $::{rua}, undef, 'stub decl ignored after compilation error';
401is $::{toru}, undef, 'stub+proto decl ignored after compilation error';
402is $::{wha}, undef, 'stub+attr decl ignored after compilation error';
403is $::{rima}, undef, 'stub+proto+attr ignored after compilation error';
404is $::{ono}, undef, 'sub decl with attr ignored after compilation error';
405is $::{whitu}, undef, 'sub decl w proto ignored after compilation error';
406is $::{waru}, undef, 'sub w attr+proto ignored after compilation error';
407is $::{iwa}, undef, 'non-empty sub decl ignored after compilation error';
408is *BEGIN{CODE}, undef, 'BEGIN leaves no stub after compilation error';
409
583c9d5c
FC
410$test = $test + 1;
411"ok $test - format inside re-eval" =~ /(?{
412 format =
413@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
414$_
415.
416write
417}).*/;
418
4a7239ff
FC
419eval '
420"${;
421
422=pod
423
424=cut
425
426}";
427';
428is $@, "", 'pod inside string in string eval';
429"${;
430
431=pod
432
433=cut
434
435}";
436print "ok ", ++$test, " - pod inside string outside of string eval\n";
437
5097bf9b
FC
438like "blah blah blah\n", qr/${\ <<END
439blah blah blah
440END
441 }/, 'here docs in multiline quoted construct';
442like "blah blah blah\n", eval q|qr/${\ <<END
443blah blah blah
444END
445 }/|, 'here docs in multiline quoted construct in string eval';
446
447# Unterminated here-docs in subst in eval; used to crash
448eval 's/${<<END}//';
449eval 's//${<<END}/';
450print "ok ", ++$test, " - unterminated here-docs in s/// in string eval\n";
451
0484b403
FC
452sub 'Hello'_he_said (_);
453is prototype "Hello::_he_said", '_', 'initial tick in sub declaration';
454
321f1aea
FC
455{
456 my @x = 'string';
457 is(eval q{ "$x[0]->strung" }, 'string->strung',
458 'literal -> after an array subscript within ""');
459 @x = ['string'];
460 # this used to give "string"
92e8e650 461 like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0\]\z/,
321f1aea
FC
462 'literal -> [0] after an array subscript within ""');
463}
464
d2691ae2
FC
465eval 'no if $] >= 5.17.4 warnings => "deprecated"';
466is 1,1, ' no crash for "no ... syntax error"';
467
3f33d153
FC
468for my $pkg(()){}
469$pkg = 3;
470is $pkg, 3, '[perl #114942] for my $foo()){} $foo';
d2691ae2 471
a20e6aae
BF
472# Check that format 'Foo still works after removing the hack from
473# force_word
474$test++;
475format 'one =
476ok @<< - format 'foo still works
477$test
478.
479{
480 local $~ = "one";
481 write();
482}
483
1a01716a
NC
484$test++;
485format ::two =
486ok @<< - format ::foo still works
487$test
488.
489{
490 local $~ = "two";
491 write();
492}
493
9dbc968d
FC
494for(__PACKAGE__) {
495 eval '$_=42';
496 is $_, 'main', '__PACKAGE__ is read-only';
497}
498
1311cfc0
FC
499$file = __FILE__;
500BEGIN{ ${"_<".__FILE__} = \1 }
501is __FILE__, $file,
502 'no __FILE__ corruption when setting CopFILESV to a ref';
503
eaaaaa32
FC
504eval 'Fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
505 .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
506 .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
507 .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
508 .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
509 .'ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo';
510like $@, "^Identifier too long at ", 'ident buffer overflow';
511
61bc2258
H
512eval 'for my a1b $i (1) {}';
513# ng: 'Missing $ on loop variable'
514like $@, "^No such class a1b at ", 'TYPE of my of for statement';
515
b5b6210a
FC
516eval 'method {} {$_,undef}';
517like $@, qq/^Can't call method "method" on unblessed reference at /,
518 'method BLOCK {...} does not try to disambiguate';
519
51a82aa9
FC
520eval '#line 1 maggapom
521 if ($a>3) { $a ++; }
522 else {printf(1/0);}';
523is $@, "Illegal division by zero at maggapom line 2.\n",
524 'else {foo} line number (no space after {) [perl #122695]';
525
1553b1d3
FC
526# parentheses needed for this to fail an assertion in S_maybe_multideref
527is +(${[{a=>214}]}[0])->{a}, 214, '($array[...])->{...}';
528
4245fea4 529# This used to fail an assertion because of the OPf_SPECIAL flag on an
4281700a
JK
530# OP_GV that started out as an OP_CONST.
531
532 sub FILE1 () { 1 }
533 sub dummy { tell FILE1 }
4245fea4 534
b39c1059
FC
535# More potential multideref assertion failures
536# OPf_PARENS on OP_RV2SV in subscript
4281700a
JK
537 $x[($_)];
538 is(1,1, "PASS: Previous line successfully parsed. OPf_PARENS on OP_RV2SV");
db7bc125 539# OPf_SPECIAL on OP_GV in subscript
4281700a
JK
540 $x[FILE1->[0]];
541 is(1,1, "PASS: Previous line successfully parsed. OPf_SPECIAL on OP_GV");
b39c1059 542
cc5af377 543# Used to crash [perl #123542]
08b999a9
FC
544eval 's /${<>{}) //';
545
2f465e08
FC
546# Also used to crash [perl #123652]
547eval{$1=eval{a:}};
548
fb0c7c3c
FC
549# Used to fail assertions [perl #123753]
550eval "map+map";
551eval "grep+grep";
552
57db463f
FC
553# ALso failed an assertion [perl #123848]
554{
555 local $SIG{__WARN__} = sub{};
556 eval 'my $_; m// ~~ 0';
557}
558
2b6a5bfb
FC
559# Used to crash [perl #125679]
560eval 'BEGIN {$^H=-1} \eval=time';
561
bdc377e5 562# Used to fail an assertion [perl #129073]
03a1fa1e
FC
563{
564 local $SIG{__WARN__} = sub{};
565 eval '${p{};sub p}()';
566}
bdc377e5 567
82269f56
DM
568# RT #124207 syntax error during stringify can leave stringify op
569# with multiple children and assertion failures
570
571eval 'qq{@{0]}${}},{})';
572is(1, 1, "RT #124207");
573
397c43d8
LM
574# RT #127993 version control conflict markers
575" this should keep working
576<<<<<<<
577" =~ /
578>>>>>>>
579/;
580for my $marker (qw(
581<<<<<<<
582=======
583>>>>>>>
584)) {
585 eval "$marker";
9c88bb56 586 like $@, qr/^Version control conflict marker at \(eval \d+\) line 1, near "$marker"/, "VCS marker '$marker' at beginning";
397c43d8 587 eval "\$_\n$marker";
9c88bb56 588 like $@, qr/^Version control conflict marker at \(eval \d+\) line 2, near "$marker"/, "VCS marker '$marker' after value";
397c43d8 589 eval "\n\$_ =\n$marker";
9c88bb56 590 like $@, qr/^Version control conflict marker at \(eval \d+\) line 3, near "$marker"/, "VCS marker '$marker' after operator";
397c43d8
LM
591}
592
e4fc7082
FC
593# keys assignments in weird contexts (mentioned in perl #128260)
594eval 'keys(%h) .= "00"';
595is $@, "", 'keys .=';
596eval 'sub { read $fh, keys %h, 0 }';
597is $@, "", 'read into keys';
598eval 'substr keys(%h),0,=3';
599is $@, "", 'substr keys assignment';
82269f56 600
10463ce6
KW
601{ # very large utf8 char in error message was overflowing buffer
602 if (length sprintf("%x", ~0) <= 8) {
603 is 1, 1, "skip because overflows on 32-bit machine";
604 }
605 else {
606 no warnings;
607 eval "q" . chr(100000000064);
608 like $@, qr/Can't find string terminator "." anywhere before EOF/,
609 'RT 128952';
610 }
e487ff5e
DM
611}
612
df13534a
DM
613# RT #130311: many parser shifts before a reduce
614
615{
616 eval '[' . ('{' x 300);
617 like $@, qr/Missing right curly or square bracket/, 'RT #130311';
618}
619
e5c165a0
AC
620# RT #130815: crash in ck_return for malformed code
621{
622 eval 'm(@{if(0){sub d{]]])}return';
623 like $@, qr/^syntax error at \(eval \d+\) line 1, near "\{\]"/,
624 'RT #130815: null pointer deref';
625}
df13534a 626
2e4e39b1
FC
627# Add new tests HERE (above this line)
628
d7425188
FC
629# bug #74022: Loop on characters in \p{OtherIDContinue}
630# This test hangs if it fails.
561e8675 631eval chr 0x387; # forces loading of utf8.pm
d7425188
FC
632is(1,1, '[perl #74022] Parser looping on OtherIDContinue chars');
633
44867030
NC
634# More awkward tests for #line. Keep these at the end, as they will screw
635# with sane line reporting for any other test failures
636
637sub check ($$$) {
638 my ($file, $line, $name) = @_;
639 my (undef, $got_file, $got_line) = caller;
640 like ($got_file, $file, "file of $name");
44867030
NC
641 is ($got_line, $line, "line of $name");
642}
643
c9de86d5 644my $this_file = qr/parser\.t(?:\.[bl]eb?)?$/;
44867030 645#line 3
bf1b738b
FC
6461 unless
6471;
648check($this_file, 5, "[perl #118931]");
649
650#line 3
c9de86d5 651check($this_file, 3, "bare line");
44867030
NC
652
653# line 5
c9de86d5 654check($this_file, 5, "bare line with leading space");
44867030 655
a5fba4f1 656#line 7
c9de86d5 657check($this_file, 7, "trailing space still valid");
44867030 658
a5fba4f1 659# line 11
c9de86d5 660check($this_file, 11, "leading and trailing");
44867030
NC
661
662# line 13
c9de86d5 663check($this_file, 13, "leading tab");
44867030
NC
664
665#line 17
c9de86d5 666check($this_file, 17, "middle tab");
44867030
NC
667
668#line 19
c9de86d5 669check($this_file, 19, "loadsaspaces");
44867030
NC
670
671#line 23 KASHPRITZA
672check(qr/^KASHPRITZA$/, 23, "bare filename");
673
674#line 29 "KAHEEEE"
675check(qr/^KAHEEEE$/, 29, "filename in quotes");
676
677#line 31 "CLINK CLOINK BZZT"
678check(qr/^CLINK CLOINK BZZT$/, 31, "filename with spaces in quotes");
679
680#line 37 "THOOM THOOM"
681check(qr/^THOOM THOOM$/, 37, "filename with tabs in quotes");
682
a5fba4f1 683#line 41 "GLINK PLINK GLUNK DINK"
44867030
NC
684check(qr/^GLINK PLINK GLUNK DINK$/, 41, "a space after the quotes");
685
686#line 43 "BBFRPRAFPGHPP
687check(qr/^"BBFRPRAFPGHPP$/, 43, "actually missing a quote is still valid");
688
689#line 47 bang eth
690check(qr/^"BBFRPRAFPGHPP$/, 46, "but spaces aren't allowed without quotes");
691
26b6dc3f
RGS
692#line 77sevenseven
693check(qr/^"BBFRPRAFPGHPP$/, 49, "need a space after the line number");
694
44867030
NC
695eval <<'EOSTANZA'; die $@ if $@;
696#line 51 "With wonderful deathless ditties|We build up the world's great cities,|And out of a fabulous story|We fashion an empire's glory:|One man with a dream, at pleasure,|Shall go forth and conquer a crown;|And three with a new song's measure|Can trample a kingdom down."
697check(qr/^With.*down\.$/, 51, "Overflow the second small buffer check");
698EOSTANZA
699
700# And now, turn on the debugger flag for long names
701$^P = 0x100;
702
703#line 53 "For we are afar with the dawning|And the suns that are not yet high,|And out of the infinite morning|Intrepid you hear us cry-|How, spite of your human scorning,|Once more God's future draws nigh,|And already goes forth the warning|That ye of the past must die."
704check(qr/^For we.*must die\.$/, 53, "Our long line is set up");
705
706eval <<'EOT'; die $@ if $@;
707#line 59 " "
708check(qr/^ $/, 59, "Overflow the first small buffer check only");
709EOT
710
711eval <<'EOSTANZA'; die $@ if $@;
712#line 61 "Great hail! we cry to the comers|From the dazzling unknown shore;|Bring us hither your sun and your summers;|And renew our world as of yore;|You shall teach us your song's new numbers,|And things that we dreamed not before:|Yea, in spite of a dreamer who slumbers,|And a singer who sings no more."
713check(qr/^Great hail!.*no more\.$/, 61, "Overflow both small buffer checks");
714EOSTANZA
715
cbf45e84
FC
716sub check_line ($$) {
717 my ($line, $name) = @_;
718 my (undef, undef, $got_line) = caller;
719 is ($got_line, $line, $name);
720}
721
83944c01 722#line 531 parser.t
cbf45e84 723<<EOU; check_line(531, 'on same line as heredoc');
83944c01
FC
724EOU
725s//<<EOV/e if 0;
726EOV
cbf45e84 727check_line(535, 'after here-doc in quotes');
6ddcf93b 728<<EOW; <<EOX;
cbf45e84
FC
729${check_line(537, 'first line of interp in here-doc');;
730 check_line(538, 'second line of interp in here-doc');}
78a635de 731EOW
6ddcf93b
FC
732${check_line(540, 'first line of interp in second here-doc on same line');;
733 check_line(541, 'second line of interp in second heredoc on same line');}
734EOX
735eval <<'EVAL';
736#line 545
737"${<<EOY; <<EOZ}";
738${check_line(546, 'first line of interp in here-doc in quotes in eval');;
739 check_line(547, 'second line of interp in here-doc in quotes in eval');}
740EOY
741${check_line(549, '1st line of interp in 2nd hd, same line in q in eval');;
742 check_line(550, '2nd line of interp in 2nd hd, same line in q in eval');}
743EOZ
744EVAL
83944c01 745
9cf27252
FC
746time
747#line 42
cbf45e84 748;check_line(42, 'line number after "nullary\n#line"');
9cf27252 749
ffdb8b16
FC
750"${
751#line 53
752_}";
cbf45e84 753check_line(54, 'line number after qq"${#line}"');
ffdb8b16
FC
754
755#line 24
756"
cbf45e84 757${check_line(25, 'line number inside qq/<newline>${...}/')}";
9cf27252 758
b42366d4
FC
759<<"END";
760${;
761#line 625
762}
763END
764check_line(627, 'line number after heredoc containing #line');
765
8c29fccb
FC
766#line 638
767<<ENE . ${
768
769ENE
770"bar"};
771check_line(642, 'line number after ${expr} surrounding heredoc body');
772
773
44867030 774__END__
82269f56 775# Don't add new tests HERE. See "Add new tests HERE" above.