1#!./perl 2 3# Checks if the parser behaves correctly in edge cases 4# (including weird syntax errors) 5 6BEGIN { 7 chdir 't' if -d 't'; 8 @INC = '../lib'; 9} 10 11require "./test.pl"; 12plan( tests => 43 ); 13 14eval '%@x=0;'; 15like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' ); 16 17# Bug 20010422.005 18eval q{{s//${}/; //}}; 19like( $@, qr/syntax error/, 'syntax error, used to dump core' ); 20 21# Bug 20010528.007 22eval q/"\x{"/; 23like( $@, qr/^Missing right brace on \\x/, 24 'syntax error in string, used to dump core' ); 25 26eval "a.b.c.d.e.f;sub"; 27like( $@, qr/^Illegal declaration of anonymous subroutine/, 28 'found by Markov chain stress testing' ); 29 30# Bug 20010831.001 31eval '($a, b) = (1, 2);'; 32like( $@, qr/^Can't modify constant item in list assignment/, 33 'bareword in list assignment' ); 34 35eval 'tie FOO, "Foo";'; 36like( $@, qr/^Can't modify constant item in tie /, 37 'tying a bareword causes a segfault in 5.6.1' ); 38 39eval 'undef foo'; 40like( $@, qr/^Can't modify constant item in undef operator /, 41 'undefing constant causes a segfault in 5.6.1 [ID 20010906.019]' ); 42 43eval 'read($bla, FILE, 1);'; 44like( $@, qr/^Can't modify constant item in read /, 45 'read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054]' ); 46 47# This used to dump core (bug #17920) 48eval q{ sub { sub { f1(f2();); my($a,$b,$c) } } }; 49like( $@, qr/error/, 'lexical block discarded by yacc' ); 50 51# bug #18573, used to corrupt memory 52eval q{ "\c" }; 53like( $@, qr/^Missing control char name in \\c/, q("\c" string) ); 54 55eval q{ qq(foo$) }; 56like( $@, qr/Final \$ should be \\\$ or \$name/, q($ at end of "" string) ); 57 58# two tests for memory corruption problems in the said variables 59# (used to dump core or produce strange results) 60 61is( "\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Qa", "a", "PL_lex_casestack" ); 62 63eval { 64{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ 65{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ 66{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ 67}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} 68}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} 69}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} 70}; 71is( $@, '', 'PL_lex_brackstack' ); 72 73{ 74 # tests for bug #20716 75 undef $a; 76 undef @b; 77 my $a="A"; 78 is("${a}{", "A{", "interpolation, qq//"); 79 is("${a}[", "A[", "interpolation, qq//"); 80 my @b=("B"); 81 is("@{b}{", "B{", "interpolation, qq//"); 82 is(qr/${a}{/, '(?-xism:A{)', "interpolation, qr//"); 83 my $c = "A{"; 84 $c =~ /${a}{/; 85 is($&, 'A{', "interpolation, m//"); 86 $c =~ s/${a}{/foo/; 87 is($c, 'foo', "interpolation, s/...//"); 88 $c =~ s/foo/${a}{/; 89 is($c, 'A{', "interpolation, s//.../"); 90 is(<<"${a}{", "A{ A[ B{\n", "interpolation, here doc"); 91${a}{ ${a}[ @{b}{ 92${a}{ 93} 94 95eval q{ sub a(;; &) { } a { } }; 96is($@, '', "';&' sub prototype confuses the lexer"); 97 98# Bug #21575 99# ensure that the second print statement works, by playing a bit 100# with the test output. 101my %data = ( foo => "\n" ); 102print "#"; 103print( 104$data{foo}); 105pass(); 106 107# Bug #21875 108# { q.* => ... } should be interpreted as hash, not block 109 110foreach my $line (split /\n/, <<'EOF') 1111 { foo => 'bar' } 1121 { qoo => 'bar' } 1131 { q => 'bar' } 1141 { qq => 'bar' } 1150 { q,'bar', } 1160 { q=bar= } 1170 { qq=bar= } 1181 { q=bar= => 'bar' } 119EOF 120{ 121 my ($expect, $eval) = split / /, $line, 2; 122 my $result = eval $eval; 123 ok($@ eq '', "eval $eval"); 124 is(ref $result, $expect ? 'HASH' : '', $eval); 125} 126 127# Bug #24212 128{ 129 local $SIG{__WARN__} = sub { }; # silence mandatory warning 130 eval q{ my $x = -F 1; }; 131 like( $@, qr/(?:syntax|parse) error .* near "F 1"/, "unknown filetest operators" ); 132 is( 133 eval q{ sub F { 42 } -F 1 }, 134 '-42', 135 '-F calls the F function' 136 ); 137} 138 139# Bug #24762 140{ 141 eval q{ *foo{CODE} ? 1 : 0 }; 142 is( $@, '', "glob subscript in conditional" ); 143} 144 145# Bug #27024 146{ 147 # this used to segfault (because $[=1 is optimized away to a null block) 148 my $x; 149 $[ = 1 while $x; 150 pass(); 151 $[ = 0; # restore the original value for less side-effects 152} 153