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 | |
b24768f0 | 10 | plan(tests => 25); |
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: { | |
83bcbc61 | 132 | skip "Different output on EBCDIC (presumably)", 2 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 | ); | |
3c47da3c | 153 | } |
e47d32dc FC |
154 | |
155 | fresh_perl_is( | |
156 | '/$a[/<<a', | |
0f9d53bb FC |
157 | "Missing right curly or square bracket at - line 1, within pattern\n" . |
158 | "syntax error at - line 1, at EOF\n" . | |
159 | "Execution of - aborted due to compilation errors.\n", | |
e47d32dc FC |
160 | { stderr => 1 }, |
161 | '/$a[/<<a with no newline [perl #123712]' | |
162 | ); | |
d27f4b91 FC |
163 | fresh_perl_is( |
164 | '/$a[m||/<<a', | |
0f9d53bb FC |
165 | "Missing right curly or square bracket at - line 1, within pattern\n" . |
166 | "syntax error at - line 1, at EOF\n" . | |
d27f4b91 FC |
167 | "Execution of - aborted due to compilation errors.\n", |
168 | { stderr => 1 }, | |
169 | '/$a[m||/<<a with no newline [perl #123712]' | |
170 | ); | |
0f9d53bb FC |
171 | |
172 | fresh_perl_is( | |
173 | '"@{"', | |
174 | "Missing right curly or square bracket at - line 1, within string\n" . | |
175 | "syntax error at - line 1, at EOF\n" . | |
176 | "Execution of - aborted due to compilation errors.\n", | |
177 | { stderr => 1 }, | |
178 | '"@{" [perl #123712]' | |
179 | ); | |
479ae48e FC |
180 | |
181 | fresh_perl_is( | |
182 | '/$0{}/', | |
183 | 'syntax error at - line 1, near "{}"' . "\n" . | |
184 | "Execution of - aborted due to compilation errors.\n", | |
185 | { stderr => 1 }, | |
de72f778 | 186 | '/$0{}/ with no newline [perl #123802]' |
479ae48e | 187 | ); |
66edcf79 FC |
188 | fresh_perl_is( |
189 | '"\L\L"', | |
190 | 'syntax error at - line 1, near "\L\L"' . "\n" . | |
191 | "Execution of - aborted due to compilation errors.\n", | |
192 | { stderr => 1 }, | |
193 | '"\L\L" with no newline [perl #123802]' | |
194 | ); | |
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 | ); | |
9d58dbc4 FC |
202 | |
203 | is eval "qq'@\x{ff13}'", "\@\x{ff13}", | |
204 | '"@<fullwidth digit>" [perl #123963]'; | |
b24768f0 FC |
205 | |
206 | fresh_perl_is( | |
207 | "s;\@{<<a;\n", | |
208 | "Can't find string terminator \"a\" anywhere before EOF at - line 1.\n", | |
209 | { stderr => 1 }, | |
210 | 's;@{<<a; [perl #123995]' | |
211 | ); |