Integrate (by hand) change #18386 from maint-5.8

[p5sagit/p5-mst-13.2.git] / t / op / magic.t

diff --git a/t/op/magic.t b/t/op/magic.t
index a85ff6b..8f598a1 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -20,7 +20,7 @@ sub ok {
 
     unless( $ok ) {
         printf "# Failed test at line %d\n", (caller)[2];
-        print  "# $info" if defined $info;
+        print  "# $info\n" if defined $info;
     }
 
     $test++;
@@ -36,7 +36,7 @@ sub skip {
     return 1;
 }
 
-print "1..46\n";
+print "1..52\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -67,7 +67,7 @@ ok $!, $!;
 close FOO; # just mention it, squelch used-only-once
 
 if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
-    skip('SIGINT not safe on this platform') for 1..2;
+    skip('SIGINT not safe on this platform') for 1..4;
 }
 else {
   # the next tests are done in a subprocess because sh spits out a
@@ -98,7 +98,35 @@ END
 
     close CMDPIPE;
 
-    $test += 2;
+    open( CMDPIPE, "| $PERL");
+    print CMDPIPE <<'END';
+
+    { package X;
+       sub DESTROY {
+           kill "INT",$$;
+       }
+    }
+    sub x {
+       my $x=bless [], 'X';
+       return sub { $x };
+    }
+    $| = 1;            # command buffering
+    $SIG{"INT"} = "ok5";
+    {
+       local $SIG{"INT"}=x();
+       print ""; # Needed to expose failure in 5.8.0 (why?)
+    }
+    sleep 1;
+    delete $SIG{"INT"};
+    kill "INT",$$; sleep 1;
+    sub ok5 {
+       print "ok 5\n";
+    }
+END
+    close CMDPIPE;
+    print $? & 0xFF ? "ok 6\n" : "not ok 6\n";
+
+    $test += 4;
 }
 
 # can we slice ENV?
@@ -201,9 +229,6 @@ EOT
     elsif ($Is_VMS) {
       $script = "[]show-shebang";
     }
-    else {
-      $script = "./show-shebang";
-    }
     if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') {  # no shebang
        $headmaybe = <<EOH ;
     eval 'exec ./perl -S \$0 \${1+"\$\@"}'
@@ -229,18 +254,7 @@ EOF
     s/\.exe//i if $Is_Dos or $Is_os2;
     s{\\}{/}g;
     ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`");
-
-    local $ENV{PATH}= ".";
-    (my $script_name = $script) =~ s/.*(show-shebang)/$1/;
-    $s1 = "\$^X is $perl, \$0 is $script_name\n" if $Is_MSWin32;
-    $_ = `$script_name`;
-    s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
-    s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
-    s{is perl}{is $perl}; # for systems where $^X is only a basename
-    s{\\}{/}g;
-    ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:");
-
-    unlink($script) || die "unlink($script): $!";
+    ok unlink($script), $!;
 }
 
 # $], $^O, $^T
@@ -249,7 +263,7 @@ ok $^O;
 ok $^T > 850000000, $^T;
 
 if ($Is_VMS || $Is_Dos || $Is_MacOS) {
-    skip("%ENV manipulations fail or aren't safe on $^O") for 1..2;
+    skip("%ENV manipulations fail or aren't safe on $^O") for 1..3;
 }
 else {
        $PATH = $ENV{PATH};
@@ -267,6 +281,15 @@ else {
 # -- Nikola Knezevic
        ok ($Is_MSWin32 ? (`set __NoNeSuCh` =~ /^(?:__NoNeSuCh=)?foo$/)
                            : (`echo \$__NoNeSuCh` eq "foo\n") );
+       if ($^O =~ /^(linux|freebsd)$/ &&
+           open CMDLINE, "/proc/$$/cmdline") {
+           chomp(my $line = scalar <CMDLINE>);
+           my $me = (split /\0/, $line)[0];
+           ok($me eq $0, 'altering $0 is effective');
+           close CMDLINE;
+       } else {
+           skip("\$0 check only on Linux and FreeBSD with /proc");
+       }
 }
 
 {
@@ -313,9 +336,10 @@ open(FOO, "nonesuch"); # Generate ENOENT
 my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
 ok ${"!"}{ENOENT};
 
-ok $^S == 0;
+ok $^S == 0 && defined $^S;
 eval { ok $^S == 1 };
-ok $^S == 0;
+eval " BEGIN { ok ! defined \$^S } ";
+ok $^S == 0 && defined $^S;
 
 ok ${^TAINT} == 0;
 eval { ${^TAINT} = 1 };
@@ -328,3 +352,20 @@ ok ${^TAINT} == 0;
 ok "@-" eq  "0 0 2 7";
 ok "@+" eq "10 1 6 10";
 
+# Tests for the magic get of $\
+{
+    my $ok = 0;
+    # [perl #19330]
+    {
+       local $\ = undef;
+       $\++; $\++;
+       $ok = $\ eq 2;
+    }
+    ok $ok;
+    $ok = 0;
+    {
+       local $\ = "a\0b";
+       $ok = "a$\b" eq "aa\0bb";
+    }
+    ok $ok;
+}