X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fcomp%2Fparser.t;h=25025cc06c68157689463d7acd227be4cbe5b5db;hb=0f5d0394b2f5b3a7ac4dba1b324a4ccfb7799a4b;hp=ab43e7340ea624e73dc1d6a73340e12b0e9434ed;hpb=961ce445580b4e9c0fefe3823cbf9226fa16b9bc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/comp/parser.t b/t/comp/parser.t index ab43e73..25025cc 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -9,7 +9,7 @@ BEGIN { } require "./test.pl"; -plan( tests => 10 ); +plan( tests => 38 ); eval '%@x=0;'; like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' ); @@ -51,3 +51,72 @@ like( $@, qr/error/, 'lexical block discarded by yacc' ); # bug #18573, used to corrupt memory eval q{ "\c" }; like( $@, qr/^Missing control char name in \\c/, q("\c" string) ); + +# two tests for memory corruption problems in the said variables +# (used to dump core or produce strange results) + +is( "\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Qa", "a", "PL_lex_casestack" ); + +eval { +{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ +{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ +{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{ +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}} +}; +is( $@, '', 'PL_lex_brackstack' ); + +{ + # tests for bug #20716 + undef $a; + undef @b; + my $a="A"; + is("${a}{", "A{", "interpolation, qq//"); + is("${a}[", "A[", "interpolation, qq//"); + my @b=("B"); + is("@{b}{", "B{", "interpolation, qq//"); + is(qr/${a}{/, '(?-xism:A{)', "interpolation, qr//"); + my $c = "A{"; + $c =~ /${a}{/; + is($&, 'A{', "interpolation, m//"); + $c =~ s/${a}{/foo/; + is($c, 'foo', "interpolation, s/...//"); + $c =~ s/foo/${a}{/; + is($c, 'A{', "interpolation, s//.../"); + is(<<"${a}{", "A{ A[ B{\n", "interpolation, here doc"); +${a}{ ${a}[ @{b}{ +${a}{ +} + +eval q{ sub a(;; &) { } a { } }; +is($@, '', "';&' sub prototype confuses the lexer"); + +# Bug #21575 +# ensure that the second print statement works, by playing a bit +# with the test output. +my %data = ( foo => "\n" ); +print "#"; +print( +$data{foo}); +pass(); + +# Bug #21875 +# { q.* => ... } should be interpreted as hash, not block + +foreach my $line (split /\n/, <<'EOF') +1 { foo => 'bar' } +1 { qoo => 'bar' } +1 { q => 'bar' } +1 { qq => 'bar' } +0 { q,'bar', } +0 { q=bar= } +0 { qq=bar= } +1 { q=bar= => 'bar' } +EOF +{ + my ($expect, $eval) = split / /, $line, 2; + my $result = eval $eval; + ok($@ eq '', "eval $eval"); + is(ref $result, $expect ? 'HASH' : '', $eval); +}