Test reverse sort as the return from a function in list and scalar

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

diff --git a/t/op/magic.t b/t/op/magic.t
index 1f98221..1c02b5b 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -36,16 +36,17 @@ sub skip {
     return 1;
 }
 
-print "1..53\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      :
@@ -125,7 +126,8 @@ END
 END
     close CMDPIPE;
     $? >>= 8 if $^O eq 'VMS'; # POSIX status hiding in 2nd byte
-    print $? & 0xFF ? "ok 6\n" : "not ok 6\n";
+    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;
 }
@@ -267,14 +269,18 @@ if ($Is_VMS || $Is_Dos || $Is_MacOS) {
     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";
@@ -292,7 +298,9 @@ else {
             my $mydollarzero = sub {
               my($arg) = shift;
               $0 = $arg if defined $arg;
-              my $ps = `ps -o command= -p $$`;
+             # 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;
@@ -300,8 +308,17 @@ else {
             };
             my $ps = $mydollarzero->("x");
             ok(!$ps  # we allow that something goes wrong with the ps command
-              # FreeBSD cannot get rid of the trailing " (perl)".
-               || $ps =~ /^x\b/,
+              # 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") for 0, 1;
@@ -331,7 +348,9 @@ 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
@@ -346,15 +365,18 @@ else {
    }, $@;
 }
 
+if ($Is_miniperl) {
+    skip ("miniperl can't rely on loading %Errno");
+} else {
+    # Make sure that Errno loading doesn't clobber $!
 
-# 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 };
@@ -389,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)" );
+}