Commit | Line | Data |
---|---|---|
bc795616 | 1 | #!perl |
da851177 FC |
2 | |
3 | # Tests too complex for t/base/lex.t | |
4 | ||
f3365a56 | 5 | use strict; |
bc795616 | 6 | use warnings; |
f3365a56 | 7 | |
a817e89d | 8 | BEGIN { chdir 't' if -d 't'; require './test.pl'; } |
f3365a56 | 9 | |
71776ae4 | 10 | plan(tests => 35); |
f3365a56 NC |
11 | |
12 | { | |
13 | no warnings 'deprecated'; | |
14 | print <<; # Yow! | |
15 | ok 1 | |
16 | ||
17 | # previous line intentionally left blank. | |
18 | ||
19 | my $yow = "ok 2"; | |
20 | print <<; # Yow! | |
21 | $yow | |
22 | ||
23 | # previous line intentionally left blank. | |
24 | } | |
25 | ||
26 | curr_test(3); | |
bc795616 JV |
27 | |
28 | ||
29 | { | |
30 | my %foo = (aap => "monkey"); | |
31 | my $foo = ''; | |
32 | is("@{[$foo{'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript'); | |
33 | is("@{[$foo {'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript - test for [perl #70091]'); | |
34 | ||
35 | # Original bug report [perl #70091] | |
36 | # #!perl | |
37 | # use warnings; | |
38 | # my %foo; | |
39 | # my $foo = ''; | |
40 | # (my $tmp = $foo) =~ s/^/$foo {$0}/e; | |
41 | # __END__ | |
42 | # | |
43 | # This program causes a segfault with 5.10.0 and 5.10.1. | |
44 | # | |
45 | # The space between '$foo' and '{' is essential, which is why piping | |
46 | # it through perl -MO=Deparse "fixes" it. | |
47 | # | |
48 | ||
49 | } | |
50 | ||
58b85e8b FC |
51 | { |
52 | delete local $ENV{PERL_UNICODE}; | |
53 | fresh_perl_is( | |
67a057d6 FC |
54 | 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"', |
55 | 'Constant(\N{a}) unknown at - line 1, within string' . "\n" | |
56 | ."Execution of - aborted due to compilation errors.\n", | |
57 | { stderr => 1 }, | |
58 | 'correct output (and no crash) when charnames cannot load for \N{...}' | |
58b85e8b FC |
59 | ); |
60 | } | |
67a057d6 FC |
61 | fresh_perl_is( |
62 | 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"}; | |
63 | $^H{charnames} = "foo" } "\N{a}"', | |
64 | "Undefined subroutine &main::foo called at - line 2.\n" | |
65 | ."Propagated at - line 2, within string\n" | |
66 | ."Execution of - aborted due to compilation errors.\n", | |
67 | { stderr => 1 }, | |
68 | 'no crash when charnames cannot load and %^H holds string' | |
69 | ); | |
70 | fresh_perl_is( | |
6d70c686 FC |
71 | 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"}; |
72 | $^H{charnames} = \"foo" } "\N{a}"', | |
d2192f4f FC |
73 | "Not a CODE reference at - line 2.\n" |
74 | ."Propagated at - line 2, within string\n" | |
67a057d6 FC |
75 | ."Execution of - aborted due to compilation errors.\n", |
76 | { stderr => 1 }, | |
77 | 'no crash when charnames cannot load and %^H holds string reference' | |
78 | ); | |
4aaee9b8 FC |
79 | |
80 | # not fresh_perl_is, as it seems to hide the error | |
81 | is runperl( | |
82 | nolib => 1, # -Ilib may also hide the error | |
83 | progs => [ | |
84 | '*{', | |
85 | ' XS::APItest::gv_fetchmeth_type()', | |
86 | '}' | |
87 | ], | |
88 | stderr => 1, | |
89 | ), | |
90 | "Undefined subroutine &XS::APItest::gv_fetchmeth_type called at -e line " | |
91 | ."2.\n", | |
92 | 'no buffer corruption with multiline *{...expr...}' | |
93 | ; | |
e660c409 FC |
94 | |
95 | $_ = "rhubarb"; | |
96 | is ${no strict; \$_}, "rhubarb", '${no strict; ...}'; | |
97 | is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb', | |
98 | 'map{no strict;...}'; | |
3c47da3c FC |
99 | |
100 | # [perl #123753] | |
101 | fresh_perl_is( | |
102 | '$eq = "ok\n"; print $' . "\0eq\n", | |
103 | "ok\n", | |
104 | { stderr => 1 }, | |
105 | '$ <null> ident' | |
106 | ); | |
107 | fresh_perl_is( | |
108 | '@eq = "ok\n"; print @' . "\0eq\n", | |
109 | "ok\n", | |
110 | { stderr => 1 }, | |
111 | '@ <null> ident' | |
112 | ); | |
113 | fresh_perl_is( | |
114 | '%eq = ("o"=>"k\n"); print %' . "\0eq\n", | |
115 | "ok\n", | |
116 | { stderr => 1 }, | |
117 | '% <null> ident' | |
118 | ); | |
119 | fresh_perl_is( | |
120 | 'sub eq { "ok\n" } print &' . "\0eq\n", | |
121 | "ok\n", | |
122 | { stderr => 1 }, | |
123 | '& <null> ident' | |
124 | ); | |
125 | fresh_perl_is( | |
126 | '$eq = "ok\n"; print ${*' . "\0eq{SCALAR}}\n", | |
127 | "ok\n", | |
128 | { stderr => 1 }, | |
129 | '* <null> ident' | |
130 | ); | |
131 | SKIP: { | |
bf8a9a15 | 132 | skip "Different output on EBCDIC (presumably)", 3 if $::IS_EBCDIC; |
3c47da3c FC |
133 | fresh_perl_is( |
134 | qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish, | |
135 | Bareword found where operator expected at - line 1, near ""ab}"ax" | |
136 | (Missing operator before ax?) | |
137 | syntax error at - line 1, near ""ab}"ax" | |
138 | Unrecognized character \\x8A; marked by <-- HERE after ab}"ax;&\0z<-- HERE near column 12 at - line 1. | |
139 | gibberish | |
140 | { stderr => 1 }, | |
141 | 'gibberish containing &\0z - used to crash [perl #123753]' | |
142 | ); | |
eea89386 FC |
143 | fresh_perl_is( |
144 | qq'"ab}"ax;&{+z}\x8Ao}\x82x;', <<gibberish, | |
145 | Bareword found where operator expected at - line 1, near ""ab}"ax" | |
146 | (Missing operator before ax?) | |
147 | syntax error at - line 1, near ""ab}"ax" | |
148 | Unrecognized character \\x8A; marked by <-- HERE after }"ax;&{+z}<-- HERE near column 14 at - line 1. | |
149 | gibberish | |
150 | { stderr => 1 }, | |
151 | 'gibberish containing &{+z} - used to crash [perl #123753]' | |
152 | ); | |
bf8a9a15 FC |
153 | fresh_perl_is( |
154 | "\@{\327\n", <<\gibberisi, | |
155 | Unrecognized character \xD7; marked by <-- HERE after @{<-- HERE near column 3 at - line 1. | |
156 | gibberisi | |
157 | { stderr => 1 }, | |
158 | '@ { \327 \n - used to garble output (or fail asan) [perl #128951]' | |
159 | ); | |
3c47da3c | 160 | } |
e47d32dc FC |
161 | |
162 | fresh_perl_is( | |
163 | '/$a[/<<a', | |
0f9d53bb FC |
164 | "Missing right curly or square bracket at - line 1, within pattern\n" . |
165 | "syntax error at - line 1, at EOF\n" . | |
166 | "Execution of - aborted due to compilation errors.\n", | |
e47d32dc FC |
167 | { stderr => 1 }, |
168 | '/$a[/<<a with no newline [perl #123712]' | |
169 | ); | |
d27f4b91 FC |
170 | fresh_perl_is( |
171 | '/$a[m||/<<a', | |
0f9d53bb FC |
172 | "Missing right curly or square bracket at - line 1, within pattern\n" . |
173 | "syntax error at - line 1, at EOF\n" . | |
d27f4b91 FC |
174 | "Execution of - aborted due to compilation errors.\n", |
175 | { stderr => 1 }, | |
176 | '/$a[m||/<<a with no newline [perl #123712]' | |
177 | ); | |
0f9d53bb FC |
178 | |
179 | fresh_perl_is( | |
180 | '"@{"', | |
181 | "Missing right curly or square bracket at - line 1, within string\n" . | |
182 | "syntax error at - line 1, at EOF\n" . | |
183 | "Execution of - aborted due to compilation errors.\n", | |
184 | { stderr => 1 }, | |
185 | '"@{" [perl #123712]' | |
186 | ); | |
479ae48e FC |
187 | |
188 | fresh_perl_is( | |
189 | '/$0{}/', | |
190 | 'syntax error at - line 1, near "{}"' . "\n" . | |
191 | "Execution of - aborted due to compilation errors.\n", | |
192 | { stderr => 1 }, | |
de72f778 | 193 | '/$0{}/ with no newline [perl #123802]' |
479ae48e | 194 | ); |
66edcf79 FC |
195 | fresh_perl_is( |
196 | '"\L\L"', | |
197 | 'syntax error at - line 1, near "\L\L"' . "\n" . | |
198 | "Execution of - aborted due to compilation errors.\n", | |
199 | { stderr => 1 }, | |
200 | '"\L\L" with no newline [perl #123802]' | |
201 | ); | |
202 | fresh_perl_is( | |
203 | '<\L\L>', | |
204 | 'syntax error at - line 1, near "\L\L"' . "\n" . | |
205 | "Execution of - aborted due to compilation errors.\n", | |
206 | { stderr => 1 }, | |
207 | '<\L\L> with no newline [perl #123802]' | |
208 | ); | |
9d58dbc4 FC |
209 | |
210 | is eval "qq'@\x{ff13}'", "\@\x{ff13}", | |
211 | '"@<fullwidth digit>" [perl #123963]'; | |
b24768f0 FC |
212 | |
213 | fresh_perl_is( | |
214 | "s;\@{<<a;\n", | |
215 | "Can't find string terminator \"a\" anywhere before EOF at - line 1.\n", | |
216 | { stderr => 1 }, | |
217 | 's;@{<<a; [perl #123995]' | |
218 | ); | |
e7127e21 FC |
219 | |
220 | fresh_perl_is( | |
221 | '$_ = q-strict.pm-; 1 ? require : die;' | |
222 | .' print qq-ok\n- if $INC{q-strict.pm-}', | |
223 | "ok\n", | |
2a91eb11 | 224 | {}, |
e7127e21 FC |
225 | 'foo ? require : bar [perl #128307]' |
226 | ); | |
89bfd824 FC |
227 | |
228 | like runperl(prog => 'sub ub(){0} ub ub', stderr=>1), qr/Bareword found/, | |
229 | '[perl #126482] Assert failure when mentioning a constant twice in a row'; | |
37817481 DC |
230 | |
231 | fresh_perl_is( | |
232 | "do\0"."000000", | |
233 | "", | |
234 | {}, | |
235 | '[perl #129069] - no output and valgrind clean' | |
236 | ); | |
237 | ||
238 | fresh_perl_is( | |
239 | "00my sub\0", | |
240 | "Missing name in \"my sub\" at - line 1.\n", | |
241 | {}, | |
242 | '[perl #129069] - "Missing name" warning and valgrind clean' | |
243 | ); | |
f54cfdac DC |
244 | |
245 | fresh_perl_like( | |
246 | "#!perl -i u\nprint 'OK'", | |
247 | qr/OK/, | |
248 | {}, | |
249 | '[perl #129336] - #!perl -i argument handling' | |
250 | ); | |
272d03f8 TC |
251 | SKIP: |
252 | { | |
253 | ord("A") == 65 | |
254 | or skip "These tests won't work on EBCIDIC", 3; | |
255 | fresh_perl_is( | |
256 | "BEGIN{\$^H=hex ~0}\xF3", | |
75219bac KW |
257 | "Integer overflow in hexadecimal number at - line 1.\n" |
258 | . "Malformed UTF-8 character: \\xf3 (too short; 1 byte available, need 4) at - line 1.\n" | |
259 | . "Malformed UTF-8 character (fatal) at - line 1.", | |
272d03f8 TC |
260 | {}, |
261 | '[perl #128996] - use of PL_op after op is freed' | |
262 | ); | |
263 | fresh_perl_like( | |
264 | qq(BEGIN{\$0="";\$^H=-hex join""=>1}""\xFF), | |
9a6c9c81 | 265 | qr/Malformed UTF-8 character: \\xff \(too short; 1 byte available, need 13\) at - line 1\./, |
272d03f8 TC |
266 | {}, |
267 | '[perl #128997] - buffer read overflow' | |
268 | ); | |
269 | fresh_perl_like( | |
270 | qq(BEGIN{\$^H=0x800000}\n 0m 0\xB5\xB500\xB5\0), | |
75219bac | 271 | qr/Malformed UTF-8 character: \\xb5 \(unexpected continuation byte 0xb5, with no preceding start byte\)/, |
272d03f8 TC |
272 | {}, |
273 | '[perl #129000] read before buffer' | |
274 | ); | |
275 | } | |
71776ae4 TC |
276 | # probably only failed under ASAN |
277 | fresh_perl_is( | |
278 | "stat\tt\$#0", | |
279 | <<'EOM', | |
280 | $# is no longer supported. Its use will be fatal in Perl 5.30 at - line 1. | |
281 | Number found where operator expected at - line 1, near "$#0" | |
282 | (Missing operator before 0?) | |
283 | Can't call method "t" on an undefined value at - line 1. | |
284 | EOM | |
285 | {}, | |
286 | "[perl #129273] heap use after free or overflow" | |
287 | ); |