Fix [RT#66098] -- stricter checking on SvIVX exposed a lack of SvIOK check
[p5sagit/p5-mst-13.2.git] / t / op / closure.t
index 78087a0..5e3bf45 100755 (executable)
@@ -12,8 +12,9 @@ BEGIN {
 }
 
 use Config;
+require './test.pl'; # for runperl()
 
-print "1..187\n";
+print "1..188\n";
 
 my $test = 1;
 sub test (&) {
@@ -446,8 +447,8 @@ END
              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;
@@ -462,15 +463,10 @@ END
            }
          } 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 = (($^O eq 'VMS') ? "$^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
@@ -480,18 +476,15 @@ END
              { 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;
@@ -641,8 +634,6 @@ f16302();
     test { $a{7}->()->() + $a{11}->()->() == 18 };
 }
 
-require './test.pl'; # for runperl()
-
 {
    # bugid #23265 - this used to coredump during destruction of PL_maincv
    # and its children
@@ -693,7 +684,22 @@ __EOF__
     test { $flag == 1 };
 }
 
+# don't copy a stale lexical; crate a fresh undef one instead
+
+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 };
+}