t/run/fresh_perl.t

   1 #!./perl
   2
   3 # ** DO NOT ADD ANY MORE TESTS HERE **
   4 # Instead, put the test in the appropriate test file and use the
   5 # fresh_perl_is()/fresh_perl_like() functions in t/test.pl.
   6
   7 # This is for tests that used to abnormally cause segfaults, and other nasty
   8 # errors that might kill the interpreter and for some reason you can't
   9 # use an eval().
  10
  11 BEGIN {
  12     chdir 't' if -d 't';
  13     @INC = '../lib';
  14     require './test.pl';        # for which_perl() etc
  15 }
  16
  17 use strict;
  18
  19 my $Perl = which_perl();
  20
  21 $|=1;
  22
  23 my @prgs = ();
  24 while(<DATA>) {
  25     if(m/^#{8,}\s*(.*)/) {
  26         push @prgs, ['', $1];
  27     }
  28     else {
  29         $prgs[-1][0] .= $_;
  30     }
  31 }
  32 plan tests => scalar @prgs;
  33
  34 foreach my $prog (@prgs) {
  35     my($raw_prog, $name) = @$prog;
  36
  37     my $switch;
  38     if ($raw_prog =~ s/^\s*(-\w.*)\n//){
  39         $switch = $1;
  40     }
  41
  42     my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog);
  43     $prog .= "\n";
  44     $expected = '' unless defined $expected;
  45
  46     if ($prog =~ /^\# SKIP: (.+)/m) {
  47         if (eval $1) {
  48             ok(1, "Skip: $1");
  49             next;
  50         }
  51     }
  52
  53     $expected =~ s/\n+$//;
  54
  55     fresh_perl_is($prog, $expected, { switches => [$switch || ''] }, $name);
  56 }
  57
  58 __END__
  59 ########
  60 $a = ":="; @_ = split /($a)/o, "a:=b:=c"; print "@_"
  61 EXPECT
  62 a := b := c
  63 ########
  64 $cusp = ~0 ^ (~0 >> 1);
  65 use integer;
  66 $, = " ";
  67 print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, 8 | (($cusp + 1) % 8 + 7), "!\n";
  68 EXPECT
  69 7 0 0 8 !
  70 ########
  71 $foo=undef; $foo->go;
  72 EXPECT
  73 Can't call method "go" on an undefined value at - line 1.
  74 ########
  75 BEGIN
  76         {
  77             "foo";
  78         }
  79 ########
  80 $array[128]=1
  81 ########
  82 $x=0x0eabcd; print $x->ref;
  83 EXPECT
  84 Can't locate object method "ref" via package "961485" (perhaps you forgot to load "961485"?) at - line 1.
  85 ########
  86 chop ($str .= <DATA>);
  87 ########
  88 close ($banana);
  89 ########
  90 $x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
  91 EXPECT
  92 25
  93 ########
  94 eval 'sub bar {print "In bar"}';
  95 ########
  96 system './perl -ne "print if eof" /dev/null'
  97 ########
  98 chop($file = <DATA>);
  99 ########
 100 package N;
 101 sub new {my ($obj,$n)=@_; bless \$n}
 102 $aa=new N 1;
 103 $aa=12345;
 104 print $aa;
 105 EXPECT
 106 12345
 107 ########
 108 $_="foo";
 109 printf(STDOUT "%s\n", $_);
 110 EXPECT
 111 foo
 112 ########
 113 push(@a, 1, 2, 3,)
 114 ########
 115 quotemeta ""
 116 ########
 117 for ("ABCDE") {
 118  &sub;
 119 s/./&sub($&)/eg;
 120 print;}
 121 sub sub {local($_) = @_;
 122 $_ x 4;}
 123 EXPECT
 124 Modification of a read-only value attempted at - line 3.
 125 ########
 126 package FOO;sub new {bless {FOO => BAR}};
 127 package main;
 128 use strict vars;
 129 my $self = new FOO;
 130 print $$self{FOO};
 131 EXPECT
 132 BAR
 133 ########
 134 $_="foo";
 135 s/.{1}//s;
 136 print;
 137 EXPECT
 138 oo
 139 ########
 140 print scalar ("foo","bar")
 141 EXPECT
 142 bar
 143 ########
 144 sub by_number { $a <=> $b; };# inline function for sort below
 145 $as_ary{0}="a0";
 146 @ordered_array=sort by_number keys(%as_ary);
 147 ########
 148 sub NewShell
 149 {
 150   local($Host) = @_;
 151   my($m2) = $#Shells++;
 152   $Shells[$m2]{HOST} = $Host;
 153   return $m2;
 154 }
 155
 156 sub ShowShell
 157 {
 158   local($i) = @_;
 159 }
 160
 161 &ShowShell(&NewShell(beach,Work,"+0+0"));
 162 &ShowShell(&NewShell(beach,Work,"+0+0"));
 163 &ShowShell(&NewShell(beach,Work,"+0+0"));
 164 ########
 165    {
 166        package FAKEARRAY;
 167
 168        sub TIEARRAY
 169        { print "TIEARRAY @_\n";
 170          die "bomb out\n" unless $count ++ ;
 171          bless ['foo']
 172        }
 173        sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
 174        sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
 175        sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
 176    }
 177
 178 eval 'tie @h, FAKEARRAY, fred' ;
 179 tie @h, FAKEARRAY, fred ;
 180 EXPECT
 181 TIEARRAY FAKEARRAY fred
 182 TIEARRAY FAKEARRAY fred
 183 DESTROY
 184 ########
 185 BEGIN { die "phooey\n" }
 186 EXPECT
 187 phooey
 188 BEGIN failed--compilation aborted at - line 1.
 189 ########
 190 BEGIN { 1/$zero }
 191 EXPECT
 192 Illegal division by zero at - line 1.
 193 BEGIN failed--compilation aborted at - line 1.
 194 ########
 195 BEGIN { undef = 0 }
 196 EXPECT
 197 Modification of a read-only value attempted at - line 1.
 198 BEGIN failed--compilation aborted at - line 1.
 199 ########
 200 {
 201     package foo;
 202     sub PRINT {
 203         shift;
 204         print join(' ', reverse @_)."\n";
 205     }
 206     sub PRINTF {
 207         shift;
 208           my $fmt = shift;
 209         print sprintf($fmt, @_)."\n";
 210     }
 211     sub TIEHANDLE {
 212         bless {}, shift;
 213     }
 214     sub READLINE {
 215         "Out of inspiration";
 216     }
 217     sub DESTROY {
 218         print "and destroyed as well\n";
 219   }
 220   sub READ {
 221       shift;
 222       print STDOUT "foo->can(READ)(@_)\n";
 223       return 100;
 224   }
 225   sub GETC {
 226       shift;
 227       print STDOUT "Don't GETC, Get Perl\n";
 228       return "a";
 229   }
 230 }
 231 {
 232     local(*FOO);
 233     tie(*FOO,'foo');
 234     print FOO "sentence.", "reversed", "a", "is", "This";
 235     print "-- ", <FOO>, " --\n";
 236     my($buf,$len,$offset);
 237     $buf = "string";
 238     $len = 10; $offset = 1;
 239     read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed";
 240     getc(FOO) eq "a" or die "foo->GETC failed";
 241     printf "%s is number %d\n", "Perl", 1;
 242 }
 243 EXPECT
 244 This is a reversed sentence.
 245 -- Out of inspiration --
 246 foo->can(READ)(string 10 1)
 247 Don't GETC, Get Perl
 248 Perl is number 1
 249 and destroyed as well
 250 ########
 251 my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
 252 EXPECT
 253 2 2 2
 254 ########
 255 # used to attach defelem magic to all immortal values,
 256 # which made restore of local $_ fail.
 257 foo(2>1);
 258 sub foo { bar() for @_;  }
 259 sub bar { local $_; }
 260 print "ok\n";
 261 EXPECT
 262 ok
 263 ########
 264 @a = ($a, $b, $c, $d) = (5, 6);
 265 print "ok\n"
 266   if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]);
 267 EXPECT
 268 ok
 269 ########
 270 print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000);
 271 EXPECT
 272 ok
 273 ########
 274 print "ok\n" if ("\0" lt "\xFF");
 275 EXPECT
 276 ok
 277 ########
 278 open(H,'run/fresh_perl.t'); # must be in the 't' directory
 279 stat(H);
 280 print "ok\n" if (-e _ and -f _ and -r _);
 281 EXPECT
 282 ok
 283 ########
 284 sub thing { 0 || return qw(now is the time) }
 285 print thing(), "\n";
 286 EXPECT
 287 nowisthetime
 288 ########
 289 $ren = 'joy';
 290 $stimpy = 'happy';
 291 { local $main::{ren} = *stimpy; print $ren, ' ' }
 292 print $ren, "\n";
 293 EXPECT
 294 happy joy
 295 ########
 296 $stimpy = 'happy';
 297 { local $main::{ren} = *stimpy; print ${'ren'}, ' ' }
 298 print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n";
 299 EXPECT
 300 happy joy
 301 ########
 302 package p;
 303 sub func { print 'really ' unless wantarray; 'p' }
 304 sub groovy { 'groovy' }
 305 package main;
 306 print p::func()->groovy(), "\n"
 307 EXPECT
 308 really groovy
 309 ########
 310 @list = ([ 'one', 1 ], [ 'two', 2 ]);
 311 sub func { $num = shift; (grep $_->[1] == $num, @list)[0] }
 312 print scalar(map &func($_), 1 .. 3), " ",
 313       scalar(map scalar &func($_), 1 .. 3), "\n";
 314 EXPECT
 315 2 3
 316 ########
 317 ($k, $s)  = qw(x 0);
 318 @{$h{$k}} = qw(1 2 4);
 319 for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }
 320 print "bogus\n" unless $s == 7;
 321 ########
 322 my $a = 'outer';
 323 eval q[ my $a = 'inner'; eval q[ print "$a " ] ];
 324 eval { my $x = 'peace'; eval q[ print "$x\n" ] }
 325 EXPECT
 326 inner peace
 327 ########
 328 -w
 329 $| = 1;
 330 sub foo {
 331     print "In foo1\n";
 332     eval 'sub foo { print "In foo2\n" }';
 333     print "Exiting foo1\n";
 334 }
 335 foo;
 336 foo;
 337 EXPECT
 338 In foo1
 339 Subroutine foo redefined at (eval 1) line 1.
 340 Exiting foo1
 341 In foo2
 342 ########
 343 $s = 0;
 344 map {#this newline here tickles the bug
 345 $s += $_} (1,2,4);
 346 print "eat flaming death\n" unless ($s == 7);
 347 ########
 348 sub foo { local $_ = shift; @_ = split; @_ }
 349 @x = foo(' x  y  z ');
 350 print "you die joe!\n" unless "@x" eq 'x y z';
 351 ########
 352 "A" =~ /(?{"{"})/       # Check it outside of eval too
 353 EXPECT
 354 ########
 355 /(?{"{"}})/     # Check it outside of eval too
 356 EXPECT
 357 Sequence (?{...}) not terminated with ')' at - line 1.
 358 ########
 359 BEGIN { @ARGV = qw(a b c d e) }
 360 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
 361 END { print "end <",shift,">\nargv <@ARGV>\n" }
 362 INIT { print "init <",shift,">\n" }
 363 CHECK { print "check <",shift,">\n" }
 364 EXPECT
 365 argv <a b c d e>
 366 begin <a>
 367 check <b>
 368 init <c>
 369 end <d>
 370 argv <e>
 371 ########
 372 -l
 373 # fdopen from a system descriptor to a system descriptor used to close
 374 # the former.
 375 open STDERR, '>&=STDOUT' or die $!;
 376 select STDOUT; $| = 1; print fileno STDOUT or die $!;
 377 select STDERR; $| = 1; print fileno STDERR or die $!;
 378 EXPECT
 379 1
 380 2
 381 ########
 382 -w
 383 sub testme { my $a = "test"; { local $a = "new test"; print $a }}
 384 EXPECT
 385 Can't localize lexical variable $a at - line 1.
 386 ########
 387 package X;
 388 sub ascalar { my $r; bless \$r }
 389 sub DESTROY { print "destroyed\n" };
 390 package main;
 391 *s = ascalar X;
 392 EXPECT
 393 destroyed
 394 ########
 395 package X;
 396 sub anarray { bless [] }
 397 sub DESTROY { print "destroyed\n" };
 398 package main;
 399 *a = anarray X;
 400 EXPECT
 401 destroyed
 402 ########
 403 package X;
 404 sub ahash { bless {} }
 405 sub DESTROY { print "destroyed\n" };
 406 package main;
 407 *h = ahash X;
 408 EXPECT
 409 destroyed
 410 ########
 411 package X;
 412 sub aclosure { my $x; bless sub { ++$x } }
 413 sub DESTROY { print "destroyed\n" };
 414 package main;
 415 *c = aclosure X;
 416 EXPECT
 417 destroyed
 418 ########
 419 package X;
 420 sub any { bless {} }
 421 my $f = "FH000"; # just to thwart any future optimisations
 422 sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
 423 sub DESTROY { print "destroyed\n" }
 424 package main;
 425 $x = any X; # to bump sv_objcount. IO objs aren't counted??
 426 *f = afh X;
 427 EXPECT
 428 destroyed
 429 destroyed
 430 ########
 431 BEGIN {
 432   $| = 1;
 433   $SIG{__WARN__} = sub {
 434     eval { print $_[0] };
 435     die "bar\n";
 436   };
 437   warn "foo\n";
 438 }
 439 EXPECT
 440 foo
 441 bar
 442 BEGIN failed--compilation aborted at - line 8.
 443 ########
 444 package X;
 445 @ISA='Y';
 446 sub new {
 447     my $class = shift;
 448     my $self = { };
 449     bless $self, $class;
 450     my $init = shift;
 451     $self->foo($init);
 452     print "new", $init;
 453     return $self;
 454 }
 455 sub DESTROY {
 456     my $self = shift;
 457     print "DESTROY", $self->foo;
 458 }
 459 package Y;
 460 sub attribute {
 461     my $self = shift;
 462     my $var = shift;
 463     if (@_ == 0) {
 464         return $self->{$var};
 465     } elsif (@_ == 1) {
 466         $self->{$var} = shift;
 467     }
 468 }
 469 sub AUTOLOAD {
 470     $AUTOLOAD =~ /::([^:]+)$/;
 471     my $method = $1;
 472     splice @_, 1, 0, $method;
 473     goto &attribute;
 474 }
 475 package main;
 476 my $x = X->new(1);
 477 for (2..3) {
 478     my $y = X->new($_);
 479     print $y->foo;
 480 }
 481 print $x->foo;
 482 EXPECT
 483 new1new22DESTROY2new33DESTROY31DESTROY1
 484 ########
 485 re();
 486 sub re {
 487     my $re = join '', eval 'qr/(??{ $obj->method })/';
 488     $re;
 489 }
 490 EXPECT
 491 ########
 492 use strict;
 493 my $foo = "ZZZ\n";
 494 END { print $foo }
 495 EXPECT
 496 ZZZ
 497 ########
 498 eval '
 499 use strict;
 500 my $foo = "ZZZ\n";
 501 END { print $foo }
 502 ';
 503 EXPECT
 504 ZZZ
 505 ########
 506 -w
 507 if (@ARGV) { print "" }
 508 else {
 509   if ($x == 0) { print "" } else { print $x }
 510 }
 511 EXPECT
 512 Use of uninitialized value $x in numeric eq (==) at - line 3.
 513 ########
 514 $x = sub {};
 515 foo();
 516 sub foo { eval { return }; }
 517 print "ok\n";
 518 EXPECT
 519 ok
 520 ########
 521 # moved to op/lc.t
 522 EXPECT
 523 ########
 524 sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next }
 525 my $x = "foo";
 526 { f } continue { print $x, "\n" }
 527 EXPECT
 528 foo
 529 ########
 530 # [perl #3066]
 531 sub C () { 1 }
 532 sub M { print "$_[0]\n" }
 533 eval "C";
 534 M(C);
 535 EXPECT
 536 1
 537 ########
 538 print qw(ab a\b a\\b);
 539 EXPECT
 540 aba\ba\b
 541 ########
 542 # lexicals declared after the myeval() definition should not be visible
 543 # within it
 544 sub myeval { eval $_[0] }
 545 my $foo = "ok 2\n";
 546 myeval('sub foo { local $foo = "ok 1\n"; print $foo; }');
 547 die $@ if $@;
 548 foo();
 549 print $foo;
 550 EXPECT
 551 ok 1
 552 ok 2
 553 ########
 554 # lexicals outside an eval"" should be visible inside subroutine definitions
 555 # within it
 556 eval <<'EOT'; die $@ if $@;
 557 {
 558     my $X = "ok\n";
 559     eval 'sub Y { print $X }'; die $@ if $@;
 560     Y();
 561 }
 562 EOT
 563 EXPECT
 564 ok
 565 ########
 566 # [ID 20001202.002 (#4821)] and change #8066 added 'at -e line 1';
 567 # reversed again as a result of [perl #17763]
 568 die qr(x)
 569 EXPECT
 570 (?^:x)
 571 ########
 572 # 20001210.003 (#4893) mjd@plover.com
 573 format REMITOUT_TOP =
 574 FOO
 575 .
 576
 577 format REMITOUT =
 578 BAR
 579 .
 580
 581 # This loop causes a segv in 5.6.0
 582 for $lineno (1..61) {
 583    write REMITOUT;
 584 }
 585
 586 print "It's OK!";
 587 EXPECT
 588 It's OK!
 589 ########
 590 # Inaba Hiroto
 591 reset;
 592 if (0) {
 593   if ("" =~ //) {
 594   }
 595 }
 596 ########
 597 # Nicholas Clark
 598 $ENV{TERM} = 0;
 599 reset;
 600 // if 0;
 601 ########
 602 # Vadim Konovalov
 603 use strict;
 604 sub new_pmop($) {
 605     my $pm = shift;
 606     return eval "sub {shift=~/$pm/}";
 607 }
 608 new_pmop "abcdef"; reset;
 609 new_pmop "abcdef"; reset;
 610 new_pmop "abcdef"; reset;
 611 new_pmop "abcdef"; reset;
 612 ########
 613 # David Dyck
 614 # coredump in 5.7.1
 615 close STDERR; die;
 616 EXPECT
 617 ########
 618 # core dump in 20000716.007 (#3516)
 619 -w
 620 "x" =~ /(\G?x)?/;
 621 ########
 622 # Bug 20010515.004 (#6998)
 623 my @h = 1 .. 10;
 624 bad(@h);
 625 sub bad {
 626    undef @h;
 627    warn "O\n";
 628    print for @_;
 629    warn "K\n";
 630 }
 631 EXPECT
 632 O
 633 Use of freed value in iteration at - line 7.
 634 ########
 635 # Bug 20010506.041 (#6952)
 636 "abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n";
 637 EXPECT
 638 ok
 639 ########
 640 my $foo = Bar->new();
 641 my @dst;
 642 END {
 643     ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/;
 644     print $_, "\n";
 645 }
 646 package Bar;
 647 sub new {
 648     my Bar $self = bless [], Bar;
 649     eval '$self';
 650     return $self;
 651 }
 652 sub DESTROY {
 653     push @dst, "$_[0]";
 654 }
 655 EXPECT
 656 Bar=ARRAY(0x...)
 657 ######## (?{...}) compilation bounces on PL_rs
 658 -0
 659 {
 660   /(?{ $x })/;
 661   # {
 662 }
 663 BEGIN { print "ok\n" }
 664 EXPECT
 665 ok
 666 ######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155 (#7947)]
 667 # This only happens if the filename is 11 characters or less.
 668 $foo = \-f "blah";
 669 print "ok" if ref $foo && !$$foo;
 670 EXPECT
 671 ok
 672 ######## [ID 20011128.159 (#7951)] 'X' =~ /\X/ segfault in 5.6.1
 673 print "ok" if 'X' =~ /\X/;
 674 EXPECT
 675 ok
 676 ######## segfault in 5.6.1 within peep()
 677 @a = (1..9);
 678 @b = sort { @c = sort { @d = sort { 0 } @a; @d; } @a; } @a;
 679 print join '', @a, "\n";
 680 EXPECT
 681 123456789
 682 ######## example from Camel 5, ch. 15, pp.406 (with my)
 683 # SKIP: ord "A" == 193 # EBCDIC
 684 use strict;
 685 use utf8;
 686 my $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
 687 $人++; # a child is born
 688 print $人, "\n";
 689 EXPECT
 690 3
 691 ######## example from Camel 5, ch. 15, pp.406 (with our)
 692 # SKIP: ord "A" == 193 # EBCDIC
 693 use strict;
 694 use utf8;
 695 our $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
 696 $人++; # a child is born
 697 print $人, "\n";
 698 EXPECT
 699 3
 700 ######## example from Camel 5, ch. 15, pp.406 (with package vars)
 701 # SKIP: ord "A" == 193 # EBCDIC
 702 use utf8;
 703 $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
 704 $人++; # a child is born
 705 print $人, "\n";
 706 EXPECT
 707 3
 708 ######## example from Camel 5, ch. 15, pp.406 (with use vars)
 709 # SKIP: ord "A" == 193 # EBCDIC
 710 use strict;
 711 use utf8;
 712 use vars qw($人);
 713 $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
 714 $人++; # a child is born
 715 print $人, "\n";
 716 EXPECT
 717 3
 718 ########
 719 # test that closures generated by eval"" hold on to the CV of the eval""
 720 # for their entire lifetime
 721 $code = eval q[
 722   sub { eval '$x = "ok 1\n"'; }
 723 ];
 724 &{$code}();
 725 print $x;
 726 EXPECT
 727 ok 1
 728 ######## [ID 20020623.009 (#9728)] nested eval/sub segfaults
 729 $eval = eval 'sub { eval "sub { %S }" }';
 730 $eval->({});
 731 ######## [perl #17951] Strange UTF error
 732 -W
 733 # From: "John Kodis" <kodis@mail630.gsfc.nasa.gov>
 734 # Newsgroups: comp.lang.perl.moderated
 735 # Subject: Strange UTF error
 736 # Date: Fri, 11 Oct 2002 16:19:58 -0400
 737 # Message-ID: <pan.2002.10.11.20.19.48.407190@mail630.gsfc.nasa.gov>
 738 $_ = "foobar\n";
 739 utf8::upgrade($_); # the original code used a UTF-8 locale (affects STDIN)
 740 # matching is actually irrelevant: avoiding several dozen of these
 741 # Illegal hexadecimal digit '   ' ignored at /usr/lib/perl5/5.8.0/utf8_heavy.pl line 152
 742 # is what matters.
 743 /^([[:digit:]]+)/;
 744 EXPECT
 745 ######## [perl #20667] unicode regex vs non-unicode regex
 746 # SKIP: !defined &DynaLoader::boot_DynaLoader && !eval 'require "unicore/UCD.pl"'
 747 # (skip under miniperl if Unicode tables are not built yet)
 748 $toto = 'Hello';
 749 $toto =~ /\w/; # this line provokes the problem!
 750 $name = 'A B';
 751 # utf8::upgrade($name) if @ARGV;
 752 if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){
 753     print "It's good! >$1< >$2<\n";
 754 } else {
 755     print "It's not good...\n";
 756 }
 757 EXPECT
 758 It's good! >A< >B<
 759 ######## [perl #8760] strangeness with utf8 and warn
 760 $_="foo";utf8::upgrade($_);/bar/i,warn$_;
 761 EXPECT
 762 foo at - line 1.
 763 ######## "#75146: 27e904532594b7fb (fix for #23810) introduces a #regression"
 764 use strict;
 765
 766 unshift @INC, sub {
 767     my ($self, $fn) = @_;
 768
 769     (my $pkg = $fn) =~ s{/}{::}g;
 770     $pkg =~ s{.pm$}{};
 771
 772     if ($pkg eq 'Credit') {
 773         my $code = <<'EOC';
 774 package Credit;
 775
 776 use NonsenseAndBalderdash;
 777
 778 1;
 779 EOC
 780         eval $code;
 781         die "\$@ is $@";
 782     }
 783
 784     #print STDERR "Generator: not one of mine, ignoring\n";
 785     return undef;
 786 };
 787
 788 # create load-on-demand new() constructors
 789 {
 790     package Credit;
 791     sub new {
 792         eval "use Credit";
 793     }
 794 };
 795
 796 eval {
 797     my $credit = new Credit;
 798 };
 799
 800 print "If you get here, you didn't crash\n";
 801 EXPECT
 802 If you get here, you didn't crash
 803 ######## [perl #112312] crash on syntax error
 804 # SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
 805 #!/usr/bin/perl
 806 use strict;
 807 use warnings;
 808 sub meow (&);
 809 my %h;
 810 my $k;
 811 meow {
 812         my $t : need_this;
 813         $t = {
 814                 size =>  $h{$k}{size};
 815                 used =>  $h{$k}(used}
 816         };
 817 };
 818 EXPECT
 819 syntax error at - line 12, near "used"
 820 syntax error at - line 12, near "used}"
 821 Unmatched right curly bracket at - line 14, at end of line
 822 Execution of - aborted due to compilation errors.
 823 ######## [perl #112312] crash on syntax error - another test
 824 # SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
 825 #!/usr/bin/perl
 826 use strict;
 827 use warnings;
 828
 829 sub meow (&);
 830
 831 my %h;
 832 my $k;
 833
 834 meow {
 835         my $t : need_this;
 836         $t = {
 837                 size => $h{$k}{size};
 838                 used => $h{$k}(used}
 839         };
 840 };
 841
 842 sub testo {
 843         my $value = shift;
 844         print;
 845         print;
 846         print;
 847         1;
 848 }
 849
 850 EXPECT
 851 syntax error at - line 15, near "used"
 852 syntax error at - line 15, near "used}"
 853 Unmatched right curly bracket at - line 17, at end of line
 854 Execution of - aborted due to compilation errors.