cd5899a5fdfd8c6d8ca4801986e874069c77cb11
[perl.git] / 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 call method "ref" without a package or object reference 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 sub C () { 1 }
531 sub M { $_[0] = 2; }
532 eval "C";
533 M(C);
534 EXPECT
535 Modification of a read-only value attempted at - line 2.
536 ########
537 print qw(ab a\b a\\b);
538 EXPECT
539 aba\ba\b
540 ########
541 # lexicals declared after the myeval() definition should not be visible
542 # within it
543 sub myeval { eval $_[0] }
544 my $foo = "ok 2\n";
545 myeval('sub foo { local $foo = "ok 1\n"; print $foo; }');
546 die $@ if $@;
547 foo();
548 print $foo;
549 EXPECT
550 ok 1
551 ok 2
552 ########
553 # lexicals outside an eval"" should be visible inside subroutine definitions
554 # within it
555 eval <<'EOT'; die $@ if $@;
556 {
557     my $X = "ok\n";
558     eval 'sub Y { print $X }'; die $@ if $@;
559     Y();
560 }
561 EOT
562 EXPECT
563 ok
564 ########
565 # [ID 20001202.002] and change #8066 added 'at -e line 1';
566 # reversed again as a result of [perl #17763]
567 die qr(x)
568 EXPECT
569 (?^:x)
570 ########
571 # 20001210.003 mjd@plover.com
572 format REMITOUT_TOP =
573 FOO
574 .
575
576 format REMITOUT =
577 BAR
578 .
579
580 # This loop causes a segv in 5.6.0
581 for $lineno (1..61) {
582    write REMITOUT;
583 }
584
585 print "It's OK!";
586 EXPECT
587 It's OK!
588 ########
589 # Inaba Hiroto
590 reset;
591 if (0) {
592   if ("" =~ //) {
593   }
594 }
595 ########
596 # Nicholas Clark
597 $ENV{TERM} = 0;
598 reset;
599 // if 0;
600 ########
601 # Vadim Konovalov
602 use strict;
603 sub new_pmop($) {
604     my $pm = shift;
605     return eval "sub {shift=~/$pm/}";
606 }
607 new_pmop "abcdef"; reset;
608 new_pmop "abcdef"; reset;
609 new_pmop "abcdef"; reset;
610 new_pmop "abcdef"; reset;
611 ########
612 # David Dyck
613 # coredump in 5.7.1
614 close STDERR; die;
615 EXPECT
616 ########
617 # core dump in 20000716.007
618 -w
619 "x" =~ /(\G?x)?/;
620 ########
621 # Bug 20010515.004
622 my @h = 1 .. 10;
623 bad(@h);
624 sub bad {
625    undef @h;
626    print "O";
627    print for @_;
628    print "K";
629 }
630 EXPECT
631 OK
632 ########
633 # Bug 20010506.041
634 "abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n";
635 EXPECT
636 ok
637 ########
638 my $foo = Bar->new();
639 my @dst;
640 END {
641     ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/;
642     print $_, "\n";
643 }
644 package Bar;
645 sub new {
646     my Bar $self = bless [], Bar;
647     eval '$self';
648     return $self;
649 }
650 sub DESTROY { 
651     push @dst, "$_[0]";
652 }
653 EXPECT
654 Bar=ARRAY(0x...)
655 ######## (?{...}) compilation bounces on PL_rs
656 -0
657 {
658   /(?{ $x })/;
659   # {
660 }
661 BEGIN { print "ok\n" }
662 EXPECT
663 ok
664 ######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155]
665 # This only happens if the filename is 11 characters or less.
666 $foo = \-f "blah";
667 print "ok" if ref $foo && !$$foo;
668 EXPECT
669 ok
670 ######## [ID 20011128.159] 'X' =~ /\X/ segfault in 5.6.1
671 print "ok" if 'X' =~ /\X/;
672 EXPECT
673 ok
674 ######## segfault in 5.6.1 within peep()
675 @a = (1..9);
676 @b = sort { @c = sort { @d = sort { 0 } @a; @d; } @a; } @a;
677 print join '', @a, "\n";
678 EXPECT
679 123456789
680 ######## example from Camel 5, ch. 15, pp.406 (with my)
681 # SKIP: ord "A" == 193 # EBCDIC
682 use strict;
683 use utf8;
684 my $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
685 $人++; # a child is born
686 print $人, "\n";
687 EXPECT
688 3
689 ######## example from Camel 5, ch. 15, pp.406 (with our)
690 # SKIP: ord "A" == 193 # EBCDIC
691 use strict;
692 use utf8;
693 our $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
694 $人++; # a child is born
695 print $人, "\n";
696 EXPECT
697 3
698 ######## example from Camel 5, ch. 15, pp.406 (with package vars)
699 # SKIP: ord "A" == 193 # EBCDIC
700 use utf8;
701 $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
702 $人++; # a child is born
703 print $人, "\n";
704 EXPECT
705 3
706 ######## example from Camel 5, ch. 15, pp.406 (with use vars)
707 # SKIP: ord "A" == 193 # EBCDIC
708 use strict;
709 use utf8;
710 use vars qw($人);
711 $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
712 $人++; # a child is born
713 print $人, "\n";
714 EXPECT
715 3
716 ########
717 # test that closures generated by eval"" hold on to the CV of the eval""
718 # for their entire lifetime
719 $code = eval q[
720   sub { eval '$x = "ok 1\n"'; }
721 ];
722 &{$code}();
723 print $x;
724 EXPECT
725 ok 1
726 ######## [ID 20020623.009] nested eval/sub segfaults
727 $eval = eval 'sub { eval "sub { %S }" }';
728 $eval->({});
729 ######## [perl #17951] Strange UTF error
730 -W
731 # From: "John Kodis" <kodis@mail630.gsfc.nasa.gov>
732 # Newsgroups: comp.lang.perl.moderated
733 # Subject: Strange UTF error
734 # Date: Fri, 11 Oct 2002 16:19:58 -0400
735 # Message-ID: <pan.2002.10.11.20.19.48.407190@mail630.gsfc.nasa.gov>
736 $_ = "foobar\n";
737 utf8::upgrade($_); # the original code used a UTF-8 locale (affects STDIN)
738 # matching is actually irrelevant: avoiding several dozen of these
739 # Illegal hexadecimal digit '   ' ignored at /usr/lib/perl5/5.8.0/utf8_heavy.pl line 152
740 # is what matters.
741 /^([[:digit:]]+)/;
742 EXPECT
743 ######## [perl #20667] unicode regex vs non-unicode regex
744 $toto = 'Hello';
745 $toto =~ /\w/; # this line provokes the problem!
746 $name = 'A B';
747 # utf8::upgrade($name) if @ARGV;
748 if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){
749     print "It's good! >$1< >$2<\n";
750 } else {
751     print "It's not good...\n";
752 }
753 EXPECT
754 It's good! >A< >B<
755 ######## [perl #8760] strangeness with utf8 and warn
756 $_="foo";utf8::upgrade($_);/bar/i,warn$_;
757 EXPECT
758 foo at - line 1.
759 ######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com>
760 -lw
761 # Make sure the presence of the CORE::GLOBAL::glob typeglob does not affect
762 # whether File::Glob::csh_glob is called.
763 if ($^O eq 'VMS') {
764     # A pattern with a double quote in it is a syntax error to LIB$FIND_FILE
765     # Should we strip quotes in Perl_vms_start_glob the way csh_glob() does?
766     print "ok1\nok2\n";
767 }
768 else {
769     ++$INC{"File/Glob.pm"}; # prevent it from loading
770     my $called1 =
771     my $called2 = 0;
772     *File::Glob::csh_glob = sub { ++$called1 };
773     my $output1 = eval q{ glob(q(./"TEST")) };
774     undef *CORE::GLOBAL::glob; # but leave the typeglob itself there
775     ++$CORE::GLOBAL::glob if 0; # "used only once"
776     undef *File::Glob::csh_glob; # avoid redefinition warnings
777     *File::Glob::csh_glob = sub { ++$called2 };
778     my $output2 = eval q{ glob(q(./"TEST")) };
779     print "ok1" if $called1 eq $called2;
780     print "ok2" if $output1 eq $output2;
781 }
782 EXPECT
783 ok1
784 ok2
785 ######## "#75146: 27e904532594b7fb (fix for #23810) introduces a #regression"
786 use strict;
787
788 unshift @INC, sub {
789     my ($self, $fn) = @_;
790
791     (my $pkg = $fn) =~ s{/}{::}g;
792     $pkg =~ s{.pm$}{};
793
794     if ($pkg eq 'Credit') {
795         my $code = <<'EOC';
796 package Credit;
797
798 use NonsenseAndBalderdash;
799
800 1;
801 EOC
802         eval $code;
803         die "\$@ is $@";
804     }
805
806     #print STDERR "Generator: not one of mine, ignoring\n";
807     return undef;
808 };
809
810 # create load-on-demand new() constructors
811 {
812     package Credit;
813     sub new {
814         eval "use Credit";
815     }
816 };
817
818 eval {
819     my $credit = new Credit;
820 };
821
822 print "If you get here, you didn't crash\n";
823 EXPECT
824 If you get here, you didn't crash
825 ######## [perl #112312] crash on syntax error
826 # SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
827 #!/usr/bin/perl
828 use strict;
829 use warnings;
830 sub meow (&);
831 my %h;
832 my $k;
833 meow {
834         my $t : need_this;
835         $t = {
836                 size =>  $h{$k}{size};
837                 used =>  $h{$k}(used}
838         };
839 };
840 EXPECT
841 syntax error at - line 12, near "used"
842 syntax error at - line 12, near "used}"
843 Unmatched right curly bracket at - line 14, at end of line
844 Execution of - aborted due to compilation errors.
845 ######## [perl #112312] crash on syntax error - another test
846 # SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
847 #!/usr/bin/perl
848 use strict;
849 use warnings;
850
851 sub meow (&);
852
853 my %h;
854 my $k;
855
856 meow {
857         my $t : need_this;
858         $t = {
859                 size => $h{$k}{size};
860                 used => $h{$k}(used}
861         };
862 };
863
864 sub testo {
865         my $value = shift;
866         print;
867         print;
868         print;
869         1;
870 }
871
872 EXPECT
873 syntax error at - line 15, near "used"
874 syntax error at - line 15, near "used}"
875 Unmatched right curly bracket at - line 17, at end of line
876 Execution of - aborted due to compilation errors.