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