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