Commit | Line | Data |
---|---|---|
a559c259 LW |
1 | #!./perl |
2 | ||
7e736055 HS |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
1c25d394 | 6 | require './test.pl'; |
7e736055 HS |
7 | } |
8 | ||
b38b3145 | 9 | plan(tests => 118); |
a559c259 | 10 | |
b38b3145 | 11 | eval 'pass();'; |
a559c259 | 12 | |
b38b3145 | 13 | is($@, ''); |
a559c259 LW |
14 | |
15 | eval "\$foo\n = # this is a comment\n'ok 3';"; | |
b38b3145 | 16 | is($foo, 'ok 3'); |
a559c259 LW |
17 | |
18 | eval "\$foo\n = # this is a comment\n'ok 4\n';"; | |
b38b3145 | 19 | is($foo, "ok 4\n"); |
a559c259 | 20 | |
378cc40b | 21 | print eval ' |
79072805 | 22 | $foo =;'; # this tests for a call through yyerror() |
b38b3145 | 23 | like($@, qr/line 2/); |
a559c259 | 24 | |
378cc40b | 25 | print eval '$foo = /'; # this tests for a call through fatal() |
b38b3145 | 26 | like($@, qr/Search/); |
378cc40b | 27 | |
b38b3145 | 28 | is(eval '"ok 7\n";', "ok 7\n"); |
378cc40b LW |
29 | |
30 | $foo = 5; | |
31 | $fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}'; | |
32 | $ans = eval $fact; | |
b38b3145 | 33 | is($ans, 120, 'calculate a factorial with recursive evals'); |
378cc40b LW |
34 | |
35 | $foo = 5; | |
a687059c | 36 | $fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);'; |
378cc40b | 37 | $ans = eval $fact; |
b38b3145 | 38 | is($ans, 120, 'calculate a factorial with recursive evals'); |
378cc40b | 39 | |
b38b3145 | 40 | my $curr_test = curr_test(); |
1c25d394 NC |
41 | my $tempfile = tempfile(); |
42 | open(try,'>',$tempfile); | |
b38b3145 | 43 | print try 'print "ok $curr_test\n";',"\n"; |
378cc40b LW |
44 | close try; |
45 | ||
1c25d394 | 46 | do "./$tempfile"; print $@; |
99b89507 LW |
47 | |
48 | # Test the singlequoted eval optimizer | |
49 | ||
b38b3145 | 50 | $i = $curr_test + 1; |
99b89507 LW |
51 | for (1..3) { |
52 | eval 'print "ok ", $i++, "\n"'; | |
53 | } | |
54 | ||
b38b3145 NC |
55 | $curr_test += 4; |
56 | ||
99b89507 | 57 | eval { |
b38b3145 NC |
58 | print "ok $curr_test\n"; |
59 | die sprintf "ok %d\n", $curr_test + 2; | |
99b89507 | 60 | 1; |
b38b3145 NC |
61 | } || printf "ok %d\n$@", $curr_test + 1; |
62 | ||
63 | curr_test($curr_test + 3); | |
99b89507 | 64 | |
c7cc6f1c GS |
65 | # check whether eval EXPR determines value of EXPR correctly |
66 | ||
67 | { | |
68 | my @a = qw(a b c d); | |
69 | my @b = eval @a; | |
b38b3145 NC |
70 | is("@b", '4'); |
71 | is($@, ''); | |
c7cc6f1c GS |
72 | |
73 | my $a = q[defined(wantarray) ? (wantarray ? ($b='A') : ($b='S')) : ($b='V')]; | |
74 | my $b; | |
75 | @a = eval $a; | |
b38b3145 NC |
76 | is("@a", 'A'); |
77 | is( $b, 'A'); | |
c7cc6f1c | 78 | $_ = eval $a; |
b38b3145 | 79 | is( $b, 'S'); |
c7cc6f1c | 80 | eval $a; |
b38b3145 | 81 | is( $b, 'V'); |
fc360e46 AB |
82 | |
83 | $b = 'wrong'; | |
84 | $x = sub { | |
85 | my $b = "right"; | |
b38b3145 | 86 | is(eval('"$b"'), $b); |
fc360e46 AB |
87 | }; |
88 | &$x(); | |
c7cc6f1c | 89 | } |
155fc61f | 90 | |
b38b3145 NC |
91 | { |
92 | my $b = 'wrong'; | |
93 | my $X = sub { | |
94 | my $b = "right"; | |
95 | is(eval('"$b"'), $b); | |
96 | }; | |
97 | &$X(); | |
98 | } | |
155fc61f GS |
99 | |
100 | # check navigation of multiple eval boundaries to find lexicals | |
101 | ||
b38b3145 | 102 | my $x = 'aa'; |
155fc61f | 103 | eval <<'EOT'; die if $@; |
0a00efa0 GS |
104 | print "# $x\n"; # clone into eval's pad |
105 | sub do_eval1 { | |
155fc61f GS |
106 | eval $_[0]; die if $@; |
107 | } | |
108 | EOT | |
b38b3145 | 109 | do_eval1('is($x, "aa")'); |
155fc61f | 110 | $x++; |
b38b3145 | 111 | do_eval1('eval q[is($x, "ab")]'); |
155fc61f | 112 | $x++; |
b38b3145 | 113 | do_eval1('sub { print "# $x\n"; eval q[is($x, "ac")] }->()'); |
0a00efa0 GS |
114 | $x++; |
115 | ||
116 | # calls from within eval'' should clone outer lexicals | |
117 | ||
118 | eval <<'EOT'; die if $@; | |
119 | sub do_eval2 { | |
120 | eval $_[0]; die if $@; | |
121 | } | |
b38b3145 | 122 | do_eval2('is($x, "ad")'); |
0a00efa0 | 123 | $x++; |
b38b3145 | 124 | do_eval2('eval q[is($x, "ae")]'); |
0a00efa0 | 125 | $x++; |
b38b3145 | 126 | do_eval2('sub { print "# $x\n"; eval q[is($x, "af")] }->()'); |
0a00efa0 GS |
127 | EOT |
128 | ||
129 | # calls outside eval'' should NOT clone lexicals from called context | |
130 | ||
a3985cdc DM |
131 | $main::ok = 'not ok'; |
132 | my $ok = 'ok'; | |
0a00efa0 GS |
133 | eval <<'EOT'; die if $@; |
134 | # $x unbound here | |
135 | sub do_eval3 { | |
136 | eval $_[0]; die if $@; | |
137 | } | |
138 | EOT | |
a3985cdc DM |
139 | { |
140 | my $ok = 'not ok'; | |
b38b3145 NC |
141 | do_eval3('is($ok, q{ok})'); |
142 | do_eval3('eval q[is($ok, q{ok})]'); | |
143 | do_eval3('sub { eval q[is($ok, q{ok})] }->()'); | |
a3985cdc | 144 | } |
6b35e009 | 145 | |
6b35e009 | 146 | { |
b38b3145 NC |
147 | my $x = curr_test(); |
148 | my $got; | |
149 | sub recurse { | |
150 | my $l = shift; | |
151 | if ($l < $x) { | |
152 | ++$l; | |
153 | eval 'print "# level $l\n"; recurse($l);'; | |
154 | die if $@; | |
155 | } | |
156 | else { | |
157 | $got = "ok $l"; | |
158 | } | |
159 | } | |
160 | local $SIG{__WARN__} = sub { fail() if $_[0] =~ /^Deep recurs/ }; | |
161 | recurse(curr_test() - 5); | |
162 | ||
163 | is($got, "ok $x", | |
164 | "recursive subroutine-call inside eval'' see its own lexicals"); | |
6b35e009 | 165 | } |
33b8ce05 | 166 | |
b38b3145 | 167 | |
33b8ce05 GS |
168 | eval <<'EOT'; |
169 | sub create_closure { | |
170 | my $self = shift; | |
171 | return sub { | |
b38b3145 | 172 | return $self; |
33b8ce05 GS |
173 | }; |
174 | } | |
175 | EOT | |
b38b3145 NC |
176 | is(create_closure("good")->(), "good", |
177 | 'closures created within eval bind correctly'); | |
2680586e | 178 | |
b38b3145 NC |
179 | $main::r = "good"; |
180 | sub terminal { eval '$r . q{!}' } | |
181 | is(do { | |
182 | my $r = "bad"; | |
2680586e | 183 | eval 'terminal($r)'; |
b38b3145 | 184 | }, 'good!', 'lexical search terminates correctly at subroutine boundary'); |
2680586e | 185 | |
b38b3145 NC |
186 | { |
187 | # Have we cured panic which occurred with require/eval in die handler ? | |
188 | local $SIG{__DIE__} = sub { eval {1}; die shift }; | |
189 | eval { die "wham_eth\n" }; | |
190 | is($@, "wham_eth\n"); | |
191 | } | |
a7c6d244 | 192 | |
a7ec2b44 GS |
193 | { |
194 | my $c = eval "(1,2)x10"; | |
b38b3145 | 195 | is($c, '2222222222', 'scalar eval"" pops stack correctly'); |
a7ec2b44 | 196 | } |
b45de488 GS |
197 | |
198 | # return from eval {} should clear $@ correctly | |
199 | { | |
200 | my $status = eval { | |
201 | eval { die }; | |
202 | print "# eval { return } test\n"; | |
203 | return; # removing this changes behavior | |
204 | }; | |
b38b3145 | 205 | is($@, '', 'return from eval {} should clear $@ correctly'); |
b45de488 GS |
206 | } |
207 | ||
208 | # ditto for eval "" | |
209 | { | |
210 | my $status = eval q{ | |
211 | eval q{ die }; | |
212 | print "# eval q{ return } test\n"; | |
213 | return; # removing this changes behavior | |
214 | }; | |
b38b3145 | 215 | is($@, '', 'return from eval "" should clear $@ correctly'); |
b45de488 | 216 | } |
3b2447bc RH |
217 | |
218 | # Check that eval catches bad goto calls | |
219 | # (BUG ID 20010305.003) | |
220 | { | |
221 | eval { | |
222 | eval { goto foo; }; | |
b38b3145 NC |
223 | like($@, qr/Can't "goto" into the middle of a foreach loop/, |
224 | 'eval catches bad goto calls'); | |
3b2447bc RH |
225 | last; |
226 | foreach my $i (1) { | |
b38b3145 | 227 | foo: fail('jumped into foreach'); |
3b2447bc RH |
228 | } |
229 | }; | |
b38b3145 NC |
230 | fail("Outer eval didn't execute the last"); |
231 | diag($@); | |
3b2447bc | 232 | } |
b6512f48 MJD |
233 | |
234 | # Make sure that "my $$x" is forbidden | |
235 | # 20011224 MJD | |
236 | { | |
b38b3145 NC |
237 | foreach (qw($$x @$x %$x $$$x)) { |
238 | eval 'my ' . $_; | |
239 | isnt($@, '', "my $_ is forbidden"); | |
240 | } | |
b6512f48 | 241 | } |
16a5162e | 242 | |
16a5162e JH |
243 | { |
244 | $@ = 5; | |
245 | eval q{}; | |
b38b3145 | 246 | cmp_ok(length $@, '==', 0, '[ID 20020623.002] eval "" doesn\'t clear $@'); |
16a5162e | 247 | } |
a3985cdc DM |
248 | |
249 | # DAPM Nov-2002. Perl should now capture the full lexical context during | |
250 | # evals. | |
251 | ||
252 | $::zzz = $::zzz = 0; | |
253 | my $zzz = 1; | |
254 | ||
255 | eval q{ | |
256 | sub fred1 { | |
b38b3145 | 257 | eval q{ is(eval '$zzz', 1); } |
a3985cdc DM |
258 | } |
259 | fred1(47); | |
260 | { my $zzz = 2; fred1(48) } | |
261 | }; | |
262 | ||
263 | eval q{ | |
264 | sub fred2 { | |
b38b3145 | 265 | is(eval('$zzz'), 1); |
a3985cdc DM |
266 | } |
267 | }; | |
268 | fred2(49); | |
269 | { my $zzz = 2; fred2(50) } | |
270 | ||
271 | # sort() starts a new context stack. Make sure we can still find | |
272 | # the lexically enclosing sub | |
273 | ||
274 | sub do_sort { | |
275 | my $zzz = 2; | |
276 | my @a = sort | |
b38b3145 | 277 | { is(eval('$zzz'), 2); $a <=> $b } |
a3985cdc DM |
278 | 2, 1; |
279 | } | |
280 | do_sort(); | |
281 | ||
282 | # more recursion and lexical scope leak tests | |
283 | ||
284 | eval q{ | |
285 | my $r = -1; | |
286 | my $yyy = 9; | |
287 | sub fred3 { | |
288 | my $l = shift; | |
289 | my $r = -2; | |
290 | return 1 if $l < 1; | |
291 | return 0 if eval '$zzz' != 1; | |
292 | return 0 if $yyy != 9; | |
293 | return 0 if eval '$yyy' != 9; | |
294 | return 0 if eval '$l' != $l; | |
295 | return $l * fred3($l-1); | |
296 | } | |
297 | my $r = fred3(5); | |
b38b3145 | 298 | is($r, 120); |
a3985cdc | 299 | $r = eval'fred3(5)'; |
b38b3145 | 300 | is($r, 120); |
a3985cdc DM |
301 | $r = 0; |
302 | eval '$r = fred3(5)'; | |
b38b3145 | 303 | is($r, 120); |
a3985cdc DM |
304 | $r = 0; |
305 | { my $yyy = 4; my $zzz = 5; my $l = 6; $r = eval 'fred3(5)' }; | |
b38b3145 | 306 | is($r, 120); |
a3985cdc DM |
307 | }; |
308 | my $r = fred3(5); | |
b38b3145 | 309 | is($r, 120); |
a3985cdc | 310 | $r = eval'fred3(5)'; |
b38b3145 | 311 | is($r, 120); |
a3985cdc DM |
312 | $r = 0; |
313 | eval'$r = fred3(5)'; | |
b38b3145 | 314 | is($r, 120); |
a3985cdc DM |
315 | $r = 0; |
316 | { my $yyy = 4; my $zzz = 5; my $l = 6; $r = eval 'fred3(5)' }; | |
b38b3145 | 317 | is($r, 120); |
a3985cdc DM |
318 | |
319 | # check that goto &sub within evals doesn't leak lexical scope | |
320 | ||
321 | my $yyy = 2; | |
322 | ||
a3985cdc DM |
323 | sub fred4 { |
324 | my $zzz = 3; | |
b38b3145 NC |
325 | is($zzz, 3); |
326 | is(eval '$zzz', 3); | |
327 | is(eval '$yyy', 2); | |
a3985cdc DM |
328 | } |
329 | ||
330 | eval q{ | |
331 | fred4(); | |
332 | sub fred5 { | |
333 | my $zzz = 4; | |
b38b3145 NC |
334 | is($zzz, 4); |
335 | is(eval '$zzz', 4); | |
336 | is(eval '$yyy', 2); | |
a3985cdc DM |
337 | goto &fred4; |
338 | } | |
339 | fred5(); | |
340 | }; | |
341 | fred5(); | |
342 | { my $yyy = 88; my $zzz = 99; fred5(); } | |
e8cf733a | 343 | eval q{ my $yyy = 888; my $zzz = 999; fred5(); }; |
a3985cdc | 344 | |
e8cf733a HS |
345 | { |
346 | $eval = eval 'sub { eval "sub { %S }" }'; | |
347 | $eval->({}); | |
b38b3145 | 348 | pass('[perl #9728] used to dump core'); |
e8cf733a | 349 | } |
a3985cdc | 350 | |
d819b83a DM |
351 | # evals that appear in the DB package should see the lexical scope of the |
352 | # thing outside DB that called them (usually the debugged code), rather | |
353 | # than the usual surrounding scope | |
354 | ||
d819b83a DM |
355 | our $x = 1; |
356 | { | |
357 | my $x=2; | |
358 | sub db1 { $x; eval '$x' } | |
359 | sub DB::db2 { $x; eval '$x' } | |
360 | package DB; | |
361 | sub db3 { eval '$x' } | |
362 | sub DB::db4 { eval '$x' } | |
363 | sub db5 { my $x=4; eval '$x' } | |
364 | package main; | |
365 | sub db6 { my $x=4; eval '$x' } | |
366 | } | |
367 | { | |
368 | my $x = 3; | |
b38b3145 NC |
369 | is(db1(), 2); |
370 | is(DB::db2(), 2); | |
371 | is(DB::db3(), 3); | |
372 | is(DB::db4(), 3); | |
373 | is(DB::db5(), 3); | |
374 | is(db6(), 4); | |
d819b83a | 375 | } |
b38b3145 | 376 | |
7e736055 HS |
377 | # [perl #19022] used to end up with shared hash warnings |
378 | # The program should generate no output, so anything we see is on stderr | |
379 | my $got = runperl (prog => '$h{a}=1; foreach my $k (keys %h) {eval qq{\$k}}', | |
380 | stderr => 1); | |
b38b3145 | 381 | is ($got, ''); |
7e736055 HS |
382 | |
383 | # And a buggy way of fixing #19022 made this fail - $k became undef after the | |
384 | # eval for a build with copy on write | |
385 | { | |
386 | my %h; | |
387 | $h{a}=1; | |
388 | foreach my $k (keys %h) { | |
b38b3145 | 389 | is($k, 'a'); |
7e736055 HS |
390 | |
391 | eval "\$k"; | |
392 | ||
b38b3145 | 393 | is($k, 'a'); |
7e736055 HS |
394 | } |
395 | } | |
77d32bb7 RGS |
396 | |
397 | sub Foo {} print Foo(eval {}); | |
b38b3145 | 398 | pass('#20798 (used to dump core)'); |
f48583aa MHM |
399 | |
400 | # check for context in string eval | |
401 | { | |
402 | my(@r,$r,$c); | |
403 | sub context { defined(wantarray) ? (wantarray ? ($c='A') : ($c='S')) : ($c='V') } | |
404 | ||
405 | my $code = q{ context() }; | |
406 | @r = qw( a b ); | |
407 | $r = 'ab'; | |
408 | @r = eval $code; | |
b38b3145 | 409 | is("@r$c", 'AA', 'string eval list context'); |
f48583aa | 410 | $r = eval $code; |
b38b3145 | 411 | is("$r$c", 'SS', 'string eval scalar context'); |
f48583aa | 412 | eval $code; |
b38b3145 | 413 | is("$c", 'V', 'string eval void context'); |
f48583aa | 414 | } |
6ab4a6ff DM |
415 | |
416 | # [perl #34682] escaping an eval with last could coredump or dup output | |
417 | ||
418 | $got = runperl ( | |
419 | prog => | |
420 | 'sub A::TIEARRAY { L: { eval { last L } } } tie @a, A; warn qq(ok\n)', | |
421 | stderr => 1); | |
422 | ||
b38b3145 | 423 | is($got, "ok\n", 'eval and last'); |
6ab4a6ff | 424 | |
eb034824 DM |
425 | # eval undef should be the same as eval "" barring any warnings |
426 | ||
427 | { | |
428 | local $@ = "foo"; | |
429 | eval undef; | |
b38b3145 | 430 | is($@, "", 'eval undef'); |
500960a6 RD |
431 | } |
432 | ||
433 | { | |
434 | no warnings; | |
94b03d7d | 435 | eval "/ /b;"; |
b38b3145 | 436 | like($@, qr/^syntax error/, 'eval syntax error, no warnings'); |
eb034824 DM |
437 | } |
438 | ||
410be5db DM |
439 | # a syntax error in an eval called magically 9eg vie tie or overload) |
440 | # resulted in an assertion failure in S_docatch, since doeval had already | |
441 | # poppedthe EVAL context due to the failure, but S_docatch expected the | |
442 | # context to still be there. | |
443 | ||
444 | { | |
445 | my $ok = 0; | |
446 | package Eval1; | |
447 | sub STORE { eval '('; $ok = 1 } | |
448 | sub TIESCALAR { bless [] } | |
449 | ||
450 | my $x; | |
451 | tie $x, bless []; | |
452 | $x = 1; | |
b38b3145 | 453 | ::is($ok, 1, 'eval docatch'); |
410be5db DM |
454 | } |
455 | ||
8433848b B |
456 | # [perl #51370] eval { die "\x{a10d}" } followed by eval { 1 } did not reset |
457 | # length $@ | |
458 | $@ = ""; | |
459 | eval { die "\x{a10d}"; }; | |
460 | $_ = length $@; | |
461 | eval { 1 }; | |
462 | ||
b38b3145 NC |
463 | cmp_ok($@, 'eq', "", 'length of $@ after eval'); |
464 | cmp_ok(length $@, '==', 0, 'length of $@ after eval'); | |
0d804ff6 | 465 | |
93f09d7b | 466 | # Check if eval { 1 }; completely resets $@ |
0d804ff6 | 467 | SKIP: { |
e0d4127d NC |
468 | skip_if_miniperl('no dynamic loading on miniperl, no Devel::Peek', 2); |
469 | require Config; | |
470 | skip('Devel::Peek was not built', 2) | |
471 | unless $Config::Config{extensions} =~ /\bDevel\/Peek\b/; | |
0d804ff6 NC |
472 | |
473 | my $tempfile = tempfile(); | |
474 | open $prog, ">", $tempfile or die "Can't create test file"; | |
475 | print $prog <<'END_EVAL_TEST'; | |
8433848b B |
476 | use Devel::Peek; |
477 | $! = 0; | |
478 | $@ = $!; | |
0d804ff6 NC |
479 | Dump($@); |
480 | print STDERR "******\n"; | |
481 | eval { die "\x{a10d}"; }; | |
482 | $_ = length $@; | |
483 | eval { 1 }; | |
484 | Dump($@); | |
485 | print STDERR "******\n"; | |
486 | print STDERR "Done\n"; | |
8433848b | 487 | END_EVAL_TEST |
0d804ff6 NC |
488 | close $prog or die "Can't close $tempfile: $!"; |
489 | my $got = runperl(progfile => $tempfile, stderr => 1); | |
490 | my ($first, $second, $tombstone) = split (/\*\*\*\*\*\*\n/, $got); | |
8433848b | 491 | |
0d804ff6 NC |
492 | is($tombstone, "Done\n", 'Program completed successfully'); |
493 | ||
494 | $first =~ s/,pNOK//; | |
495 | s/ PV = 0x[0-9a-f]+/ PV = 0x/ foreach $first, $second; | |
496 | s/ LEN = [0-9]+/ LEN = / foreach $first, $second; | |
673f72bf CB |
497 | # Dump may double newlines through pipes, though not files |
498 | # which is what this test used to use. | |
499 | $second =~ s/ IV = 0\n\n/ IV = 0\n/ if $^O eq 'VMS'; | |
0d804ff6 NC |
500 | |
501 | is($second, $first, 'eval { 1 } completely resets $@'); | |
8433848b | 502 | } |
410be5db | 503 | |
fa13de94 RGS |
504 | # Test that "use feature" and other hint transmission in evals and s///ee |
505 | # don't leak memory | |
506 | { | |
507 | use feature qw(:5.10); | |
e8514a9e | 508 | my $count_expected = ($^H & 0x20000) ? 2 : 1; |
fa13de94 RGS |
509 | my $t; |
510 | my $s = "a"; | |
511 | $s =~ s/a/$t = \%^H; qq( qq() );/ee; | |
0d804ff6 | 512 | is(Internals::SvREFCNT(%$t), $count_expected, 'RT 63110'); |
fa13de94 | 513 | } |
f5fa9033 | 514 | |
3b9d46a3 GG |
515 | { |
516 | # test that the CV compiled for the eval is freed by checking that no additional | |
517 | # reference to outside lexicals are made. | |
518 | my $x; | |
1c2e8cca | 519 | is(Internals::SvREFCNT($x), 1, "originally only 1 reference"); |
3b9d46a3 GG |
520 | eval '$x'; |
521 | is(Internals::SvREFCNT($x), 1, "execution eval doesn't create new references"); | |
522 | } | |
523 | ||
f5fa9033 NC |
524 | fresh_perl_is(<<'EOP', "ok\n", undef, 'RT #70862'); |
525 | $::{'@'}=''; | |
526 | eval {}; | |
527 | print "ok\n"; | |
528 | EOP | |
529 | ||
530 | fresh_perl_is(<<'EOP', "ok\n", undef, 'variant of RT #70862'); | |
531 | eval { | |
532 | $::{'@'}=''; | |
533 | }; | |
534 | print "ok\n"; | |
535 | EOP | |
dfd167e9 NC |
536 | |
537 | fresh_perl_is(<<'EOP', "ok\n", undef, 'related to RT #70862'); | |
538 | $::{'@'}=\3; | |
539 | eval {}; | |
540 | print "ok\n"; | |
541 | EOP | |
542 | ||
543 | fresh_perl_is(<<'EOP', "ok\n", undef, 'related to RT #70862'); | |
544 | eval { | |
545 | $::{'@'}=\3; | |
546 | }; | |
547 | print "ok\n"; | |
548 | EOP | |
ae533554 | 549 | |
ae533554 FR |
550 | fresh_perl_is(<<'EOP', "ok\n", undef, 'segfault on syntax errors in block evals'); |
551 | # localize the hits hash so the eval ends up with the pad offset of a copy of it in its targ | |
552 | BEGIN { $^H |= 0x00020000 } | |
553 | eval q{ eval { + } }; | |
554 | print "ok\n"; | |
555 | EOP | |
f678642f | 556 | |
3e5c0189 DM |
557 | fresh_perl_is(<<'EOP', "ok\n", undef, 'assert fail on non-string in Perl_lex_start'); |
558 | use overload '""' => sub { '1;' }; | |
559 | my $ov = bless []; | |
560 | eval $ov; | |
561 | print "ok\n"; | |
562 | EOP | |
563 | ||
3aadd5cd FC |
564 | for my $k (!0) { |
565 | eval 'my $do_something_with = $k'; | |
566 | eval { $k = 'mon' }; | |
567 | is "a" =~ /a/, "1", | |
568 | "string eval leaves readonly lexicals readonly [perl #19135]"; | |
569 | } |