Add tests for the C<my $x if foo> deprecation, and change the
[p5sagit/p5-mst-13.2.git] / t / op / magic.t
index f48422b..7a93281 100755 (executable)
@@ -36,7 +36,7 @@ sub skip {
     return 1;
 }
 
-print "1..52\n";
+print "1..53\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -125,7 +125,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;
 }
@@ -264,17 +265,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";
@@ -286,10 +291,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;
        }
 }