}
use Config;
+require './test.pl'; # for runperl()
-print "1..184\n";
+print "1..187\n";
my $test = 1;
sub test (&) {
close READ2;
open STDOUT, ">&WRITE" or die "Can't redirect STDOUT: $!";
open STDERR, ">&WRITE2" or die "Can't redirect STDERR: $!";
- exec './perl', '-w', '-'
- or die "Can't exec ./perl: $!";
+ exec which_perl(), '-w', '-'
+ or die "Can't exec perl: $!";
} else {
# Parent process here.
close WRITE;
my $errfile = "terr$$"; $errfile++ while -e $errfile;
my @tmpfiles = ($cmdfile, $errfile);
open CMD, ">$cmdfile"; print CMD $code; close CMD;
- my $cmd = (($^O eq 'VMS') ? "MCR $^X"
- : ($^O eq 'MSWin32') ? '.\perl'
- : ($^O eq 'MacOS') ? $^X
- : ($^O eq 'NetWare') ? 'perl'
- : './perl');
+ my $cmd = which_perl();
$cmd .= " -w $cmdfile 2>$errfile";
if ($^O eq 'VMS' or $^O eq 'MSWin32' or $^O eq 'NetWare') {
# Use pipe instead of system so we don't inherit STD* from
test { $a{7}->()->() + $a{11}->()->() == 18 };
}
+{
+ # bugid #23265 - this used to coredump during destruction of PL_maincv
+ # and its children
+
+ my $progfile = "b23265.pl";
+ open(T, ">$progfile") or die "$0: $!\n";
+ print T << '__EOF__';
+ print
+ sub {$_[0]->(@_)} -> (
+ sub {
+ $_[1]
+ ? $_[0]->($_[0], $_[1] - 1) . sub {"x"}->()
+ : "y"
+ },
+ 2
+ )
+ , "\n"
+ ;
+__EOF__
+ close T;
+ my $got = runperl(progfile => $progfile);
+ test { chomp $got; $got eq "yxx" };
+ END { 1 while unlink $progfile }
+}
+
+{
+ # bugid #24914 = used to coredump restoring PL_comppad in the
+ # savestack, due to the early freeing of the anon closure
+
+ my $got = runperl(stderr => 1, prog =>
+'sub d {die} my $f; $f = sub {my $x=1; $f = 0; d}; eval{$f->()}; print qq(ok\n)'
+ );
+ test { $got eq "ok\n" };
+}
+
+# After newsub is redefined outside the BEGIN, it's CvOUTSIDE should point
+# to main rather than BEGIN, and BEGIN should be freed.
+
+{
+ my $flag = 0;
+ sub X::DESTROY { $flag = 1 }
+ {
+ my $x;
+ BEGIN {$x = \&newsub }
+ sub newsub {};
+ $x = bless {}, 'X';
+ }
+ test { $flag == 1 };
+}
+
+
+
+
+