X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fmagic.t;h=1c02b5bbad0b05e8ecd842d5a3414e200ca6a30c;hb=a1824f2aba8e109cac73756dc271522cdd4a8200;hp=8f598a104905e44c2ab6f271414bc1e4a2c028ab;hpb=2d4fcd5e8be8d83efa948a259c49b56fc6c27ee5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/magic.t b/t/op/magic.t
index 8f598a1..1c02b5b 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -36,16 +36,17 @@ sub skip {
     return 1;
 }
 
-print "1..52\n";
-
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_NetWare = $^O eq 'NetWare';
-$Is_VMS     = $^O eq 'VMS';
-$Is_Dos     = $^O eq 'dos';
-$Is_os2     = $^O eq 'os2';
-$Is_Cygwin  = $^O eq 'cygwin';
-$Is_MacOS   = $^O eq 'MacOS';
-$Is_MPE     = $^O eq 'mpeix';		
+print "1..54\n";
+
+$Is_MSWin32  = $^O eq 'MSWin32';
+$Is_NetWare  = $^O eq 'NetWare';
+$Is_VMS      = $^O eq 'VMS';
+$Is_Dos      = $^O eq 'dos';
+$Is_os2      = $^O eq 'os2';
+$Is_Cygwin   = $^O eq 'cygwin';
+$Is_MacOS    = $^O eq 'MacOS';
+$Is_MPE      = $^O eq 'mpeix';		
+$Is_miniperl = $ENV{PERL_CORE_MINITEST};
 
 $PERL = ($Is_NetWare            ? 'perl'   :
 	 ($Is_MacOS || $Is_VMS) ? $^X      :
@@ -124,7 +125,9 @@ END
     }
 END
     close CMDPIPE;
-    print $? & 0xFF ? "ok 6\n" : "not ok 6\n";
+    $? >>= 8 if $^O eq 'VMS'; # POSIX status hiding in 2nd byte
+    my $todo = ($^O eq 'os2' ? ' # TODO: EMX v0.9d_fix4 bug: wrong nibble? ' : '');
+    print $? & 0xFF ? "ok 6$todo\n" : "not ok 6$todo\n";
 
     $test += 4;
 }
@@ -263,17 +266,21 @@ 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..3;
+    skip("%ENV manipulations fail or aren't safe on $^O") for 1..4;
 }
 else {
-	$PATH = $ENV{PATH};
-	$PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
-	$ENV{foo} = "bar";
-	%ENV = ();
-	$ENV{PATH} = $PATH;
-	$ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
-	ok ($Is_MSWin32 ? (`set foo 2>NUL` eq "")
-				: (`echo \$foo` eq "\n") );
+	if ($ENV{PERL_VALGRIND}) {
+	    skip("clearing \%ENV is not safe when running under valgrind");
+	} else {
+	    $PATH = $ENV{PATH};
+	    $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
+	    $ENV{foo} = "bar";
+	    %ENV = ();
+	    $ENV{PATH} = $PATH;
+	    $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
+	    ok ($Is_MSWin32 ? (`set foo 2>NUL` eq "")
+			    : (`echo \$foo` eq "\n") );
+	}
 
 	$ENV{__NoNeSuCh} = "foo";
 	$0 = "bar";
@@ -285,10 +292,36 @@ else {
 	    open CMDLINE, "/proc/$$/cmdline") {
 	    chomp(my $line = scalar <CMDLINE>);
 	    my $me = (split /\0/, $line)[0];
-	    ok($me eq $0, 'altering $0 is effective');
+	    ok($me eq $0, 'altering $0 is effective (testing with /proc/)');
 	    close CMDLINE;
+            # perlbug #22811
+            my $mydollarzero = sub {
+              my($arg) = shift;
+              $0 = $arg if defined $arg;
+	      # In FreeBSD the ps -o command= will cause
+	      # an empty header line, grab only the last line.
+              my $ps = (`ps -o command= -p $$`)[-1];
+              return if $?;
+              chomp $ps;
+              printf "# 0[%s]ps[%s]\n", $0, $ps;
+              $ps;
+            };
+            my $ps = $mydollarzero->("x");
+            ok(!$ps  # we allow that something goes wrong with the ps command
+	       # In Linux 2.4 we would get an exact match ($ps eq 'x') but
+	       # in Linux 2.2 there seems to be something funny going on:
+	       # it seems as if the original length of the argv[] would
+	       # be stored in the proc struct and then used by ps(1),
+	       # no matter what characters we use to pad the argv[].
+	       # (And if we use \0:s, they are shown as spaces.)  Sigh.
+               || $ps =~ /^x\s*$/
+	       # FreeBSD cannot get rid of both the leading "perl :"
+	       # and the trailing " (perl)": some FreeBSD versions
+	       # can get rid of the first one.
+	       || ($^O eq 'freebsd' && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/),
+		       'altering $0 is effective (testing with `ps`)');
 	} else {
-	    skip("\$0 check only on Linux and FreeBSD with /proc");
+	    skip("\$0 check only on Linux and FreeBSD") for 0, 1;
 	}
 }
 
@@ -315,26 +348,35 @@ else {
     skip('no caseless %ENV support') for 1..4;
 }
 
+if ($Is_miniperl) {
+    skip ("miniperl can't rely on loading %Errno") for 1..2;
+} else {
+   no warnings 'void';
+
 # Make sure Errno hasn't been prematurely autoloaded
 
-ok !defined %Errno::;
+   ok !defined %Errno::;
 
 # Test auto-loading of Errno when %! is used
 
-ok scalar eval q{
-   my $errs = %!;
-   defined %Errno::;
-}, $@;
-
+   ok scalar eval q{
+      %!;
+      defined %Errno::;
+   }, $@;
+}
 
-# Make sure that Errno loading doesn't clobber $!
+if ($Is_miniperl) {
+    skip ("miniperl can't rely on loading %Errno");
+} else {
+    # Make sure that Errno loading doesn't clobber $!
 
-undef %Errno::;
-delete $INC{"Errno.pm"};
+    undef %Errno::;
+    delete $INC{"Errno.pm"};
 
-open(FOO, "nonesuch"); # Generate ENOENT
-my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
-ok ${"!"}{ENOENT};
+    open(FOO, "nonesuch"); # Generate ENOENT
+    my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
+    ok ${"!"}{ENOENT};
+}
 
 ok $^S == 0 && defined $^S;
 eval { ok $^S == 1 };
@@ -369,3 +411,15 @@ ok "@+" eq "10 1 6 10";
     }
     ok $ok;
 }
+
+# Test for bug [perl #27839]
+{
+    my $x;
+    sub f {
+	"abc" =~ /(.)./;
+	$x = "@+";
+	return @+;
+    };
+    my @y = f();
+    ok( $x eq "@y", "return a magic array ($x) vs (@y)" );
+}