}
} else {
# No fork(). Do it the hard way.
- my $cmdfile = "tcmd$$"; $cmdfile++ while -e $cmdfile;
- my $errfile = "terr$$"; $errfile++ while -e $errfile;
- my @tmpfiles = ($cmdfile, $errfile);
+ my $cmdfile = tempfile();
+ my $errfile = tempfile();
open CMD, ">$cmdfile"; print CMD $code; close CMD;
my $cmd = which_perl();
$cmd .= " -w $cmdfile 2>$errfile";
{ local $/; $output = join '', <PERL> }
close PERL;
} else {
- my $outfile = "tout$$"; $outfile++ while -e $outfile;
- push @tmpfiles, $outfile;
+ my $outfile = tempfile();
system "$cmd >$outfile";
{ local $/; open IN, $outfile; $output = <IN>; close IN }
}
if ($?) {
printf "not ok: exited with error code %04X\n", $?;
- $debugging or do { 1 while unlink @tmpfiles };
exit;
}
{ local $/; open IN, $errfile; $errors = <IN>; close IN }
- 1 while unlink @tmpfiles;
}
print $output;
print STDERR $errors;
test { $flag == 1 };
}
-# although the 'my $x if ...' form is deprecated, it must still work.
-# Ensure that cloning a stale var gives a new undef value rather than
-# sharing the old value
+# don't copy a stale lexical; crate a fresh undef one instead
-{
- sub f {
- my $a = 1 if $_[0];
- return sub { \$a };
- }
- my $c1 = f(1);
- my $c2 = f(0);
- my $r1 = $c1->();
- my $r2 = $c2->();
- warn "r1=$r1 r2=$r2\n";
- test { !defined $$r2 };
- test { $r1 ne $r2 };
+sub f {
+ my $x if $_[0];
+ sub { \$x }
}
+{
+ f(1);
+ my $c1= f(0);
+ my $c2= f(0);
+ my $r1 = $c1->();
+ my $r2 = $c2->();
+ test { $r1 != $r2 };
+}