This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use fnc to force out malformed warnings
[perl5.git] / t / op / lex.t
CommitLineData
bc795616 1#!perl
da851177
FC
2
3# Tests too complex for t/base/lex.t
4
f3365a56 5use strict;
bc795616 6use warnings;
f3365a56 7
a817e89d 8BEGIN { chdir 't' if -d 't'; require './test.pl'; }
f3365a56 9
cbe6b21e 10plan(tests => 34);
f3365a56
NC
11
12{
13 no warnings 'deprecated';
14 print <<; # Yow!
15ok 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
26curr_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
61fresh_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);
70fresh_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
81is 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";
96is ${no strict; \$_}, "rhubarb", '${no strict; ...}';
97is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb',
98 'map{no strict;...}';
3c47da3c
FC
99
100# [perl #123753]
101fresh_perl_is(
102 '$eq = "ok\n"; print $' . "\0eq\n",
103 "ok\n",
104 { stderr => 1 },
105 '$ <null> ident'
106);
107fresh_perl_is(
108 '@eq = "ok\n"; print @' . "\0eq\n",
109 "ok\n",
110 { stderr => 1 },
111 '@ <null> ident'
112);
113fresh_perl_is(
114 '%eq = ("o"=>"k\n"); print %' . "\0eq\n",
115 "ok\n",
116 { stderr => 1 },
117 '% <null> ident'
118);
119fresh_perl_is(
120 'sub eq { "ok\n" } print &' . "\0eq\n",
121 "ok\n",
122 { stderr => 1 },
123 '& <null> ident'
124);
125fresh_perl_is(
126 '$eq = "ok\n"; print ${*' . "\0eq{SCALAR}}\n",
127 "ok\n",
128 { stderr => 1 },
129 '* <null> ident'
130);
131SKIP: {
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,
135Bareword found where operator expected at - line 1, near ""ab}"ax"
136 (Missing operator before ax?)
137syntax error at - line 1, near ""ab}"ax"
138Unrecognized character \\x8A; marked by <-- HERE after ab}"ax;&\0z<-- HERE near column 12 at - line 1.
139gibberish
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,
145Bareword found where operator expected at - line 1, near ""ab}"ax"
146 (Missing operator before ax?)
147syntax error at - line 1, near ""ab}"ax"
148Unrecognized character \\x8A; marked by <-- HERE after }"ax;&{+z}<-- HERE near column 14 at - line 1.
149gibberish
150 { stderr => 1 },
151 'gibberish containing &{+z} - used to crash [perl #123753]'
152 );
bf8a9a15
FC
153 fresh_perl_is(
154 "\@{\327\n", <<\gibberisi,
155Unrecognized character \xD7; marked by <-- HERE after @{<-- HERE near column 3 at - line 1.
156gibberisi
157 { stderr => 1 },
158 '@ { \327 \n - used to garble output (or fail asan) [perl #128951]'
159 );
3c47da3c 160}
e47d32dc
FC
161
162fresh_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
170fresh_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
179fresh_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
188fresh_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
195fresh_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);
202fresh_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
210is eval "qq'@\x{ff13}'", "\@\x{ff13}",
211 '"@<fullwidth digit>" [perl #123963]';
b24768f0
FC
212
213fresh_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
220fresh_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
228like 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
231fresh_perl_is(
232 "do\0"."000000",
233 "",
234 {},
235 '[perl #129069] - no output and valgrind clean'
236);
237
238fresh_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
245fresh_perl_like(
246 "#!perl -i u\nprint 'OK'",
247 qr/OK/,
248 {},
249 '[perl #129336] - #!perl -i argument handling'
250);
272d03f8
TC
251SKIP:
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}