This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
92b9a6ca415ee7b19a0a965a429bbc8bdfbceeb6
[perl5.git] / t / comp / parser.t
1 #!./perl
2
3 # Checks if the parser behaves correctly in edge cases
4 # (including weird syntax errors)
5
6 BEGIN {
7     chdir 't' if -d 't';
8     @INC = '../lib';
9 }
10
11 require "./test.pl";
12 plan( tests => 44 );
13
14 eval '%@x=0;';
15 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
16
17 # Bug 20010422.005
18 eval q{{s//${}/; //}};
19 like( $@, qr/syntax error/, 'syntax error, used to dump core' );
20
21 # Bug 20010528.007
22 eval q/"\x{"/;
23 like( $@, qr/^Missing right brace on \\x/,
24     'syntax error in string, used to dump core' );
25
26 eval "a.b.c.d.e.f;sub";
27 like( $@, qr/^Illegal declaration of anonymous subroutine/,
28     'found by Markov chain stress testing' );
29
30 # Bug 20010831.001
31 eval '($a, b) = (1, 2);';
32 like( $@, qr/^Can't modify constant item in list assignment/,
33     'bareword in list assignment' );
34
35 eval 'tie FOO, "Foo";';
36 like( $@, qr/^Can't modify constant item in tie /,
37     'tying a bareword causes a segfault in 5.6.1' );
38
39 eval 'undef foo';
40 like( $@, qr/^Can't modify constant item in undef operator /,
41     'undefing constant causes a segfault in 5.6.1 [ID 20010906.019]' );
42
43 eval 'read($bla, FILE, 1);';
44 like( $@, 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)
48 eval q{ sub { sub { f1(f2();); my($a,$b,$c) } } };
49 like( $@, qr/error/, 'lexical block discarded by yacc' );
50
51 # bug #18573, used to corrupt memory
52 eval q{ "\c" };
53 like( $@, qr/^Missing control char name in \\c/, q("\c" string) );
54
55 eval q{ qq(foo$) };
56 like( $@, 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
61 is( "\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Q\Qa", "a", "PL_lex_casestack" );
62
63 eval {
64 {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
65 {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
66 {{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
67 }}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
68 }}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
69 }}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
70 };
71 is( $@, '', '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
95 eval q{ sub a(;; &) { } a { } };
96 is($@, '', "';&' 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.
101 my %data = ( foo => "\n" );
102 print "#";
103 print(
104 $data{foo});
105 pass();
106
107 # Bug #21875
108 # { q.* => ... } should be interpreted as hash, not block
109
110 foreach my $line (split /\n/, <<'EOF')
111 1 { foo => 'bar' }
112 1 { qoo => 'bar' }
113 1 { q   => 'bar' }
114 1 { qq  => 'bar' }
115 0 { q,'bar', }
116 0 { q=bar= }
117 0 { qq=bar= }
118 1 { q=bar= => 'bar' }
119 EOF
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 #25824
146 {
147     eval q{ sub f { @a=@b=@c;  {use} } };
148     like( $@, qr/syntax error/, "use without body" );
149 }
150
151 # Bug #27024
152 {
153     # this used to segfault (because $[=1 is optimized away to a null block)
154     my $x;
155     $[ = 1 while $x;
156     pass();
157     $[ = 0; # restore the original value for less side-effects
158 }