[perl #68108] : also fix if/else constant folding

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

diff --git a/t/op/magic.t b/t/op/magic.t
old mode 100755 (executable)
new mode 100644 (file)
index f8d0e24..f8143a2
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -4,6 +4,7 @@ BEGIN {
     $| = 1;
     chdir 't' if -d 't';
     @INC = '../lib';
+    $ENV{PATH} = '/bin' if ${^TAINT};
     $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
     require './test.pl';
 }
@@ -11,8 +12,7 @@ BEGIN {
 use warnings;
 use Config;
 
-
-plan (tests => 59);
+plan (tests => 79);
 
 $Is_MSWin32  = $^O eq 'MSWin32';
 $Is_NetWare  = $^O eq 'NetWare';
@@ -31,6 +31,11 @@ $PERL = $ENV{PERL}
        $Is_MSWin32            ? '.\perl' :
        './perl');
 
+END {
+    # On VMS, environment variable changes are peristent after perl exits
+    delete $ENV{'FOO'} if $Is_VMS;
+}
+
 eval '$ENV{"FOO"} = "hi there";';      # check that ENV is inited inside eval
 # cmd.exe will echo 'variable=value' but 4nt will echo just the value
 # -- Nikola Knezevic
@@ -182,6 +187,7 @@ like ($@, qr/^Modification of a read-only value attempted/);
        # Cygwin turns the symlink into the real file
        chomp($wd = `pwd`);
        $wd =~ s#/t$##;
+       $wd =~ /(.*)/; $wd = $1; # untaint
        if ($Is_Cygwin) {
           $wd = Cygwin::win_to_posix_path(Cygwin::posix_to_win_path($wd, 1));
        }
@@ -240,7 +246,7 @@ EOX
 EOH
     }
     $s1 = "\$^X is $perl, \$0 is $script\n";
-    ok open(SCRIPT, ">$script") or diag $!;
+    ok open(SCRIPT, ">$script") or diag "Can't write to $script: $!";
     ok print(SCRIPT $headmaybe . <<EOB . $middlemaybe . <<'EOF' . $tailmaybe) or diag $!;
 #!$wd/perl
 EOB
@@ -355,7 +361,7 @@ SKIP: {
 {
     my $ok = 1;
     my $warn = '';
-    local $SIG{'__WARN__'} = sub { $ok = 0; $warn = join '', @_; };
+    local $SIG{'__WARN__'} = sub { $ok = 0; $warn = join '', @_; $warn =~ s/\n$//; };
     $! = undef;
     local $TODO = $Is_VMS ? "'\$!=undef' does throw a warning" : '';
     ok($ok, $warn);
@@ -408,9 +414,10 @@ eval { is $^S,1 };
 eval " BEGIN { ok ! defined \$^S } ";
 is $^S, 0;
 
-is ${^TAINT}, 0;
+my $taint = ${^TAINT};
+is ${^TAINT}, $taint;
 eval { ${^TAINT} = 1 };
-is ${^TAINT}, 0;
+is ${^TAINT}, $taint;
 
 # 5.6.1 had a bug: @+ and @- were not properly interpolated
 # into double-quoted strings
@@ -470,3 +477,28 @@ SKIP: {
     is $@, '', 'Assign a shared key to a magic hash';
     $@ and print "# $@";
 }
+
+# Tests for Perl_magic_clearsig
+foreach my $sig (qw(__WARN__ INT)) {
+    $SIG{$sig} = lc $sig;
+    is $SIG{$sig}, 'main::' . lc $sig, "Can assign to $sig";
+    is delete $SIG{$sig}, 'main::' . lc $sig, "Can delete from $sig";
+    is $SIG{$sig}, undef, "$sig is now gone";
+    is delete $SIG{$sig}, undef, "$sig remains gone";
+}
+
+# And now one which doesn't exist;
+{
+    no warnings 'signal';
+    $SIG{HUNGRY} = 'mmm, pie';
+}
+is $SIG{HUNGRY}, 'mmm, pie', 'Can assign to HUNGRY';
+is delete $SIG{HUNGRY}, 'mmm, pie', 'Can delete from HUNGRY';
+is $SIG{HUNGRY}, undef, "HUNGRY is now gone";
+is delete $SIG{HUNGRY}, undef, "HUNGRY remains gone";
+
+# Test deleting signals that we never set
+foreach my $sig (qw(__DIE__ _BOGUS_HOOK KILL THIRSTY)) {
+    is $SIG{$sig}, undef, "$sig is not present";
+    is delete $SIG{$sig}, undef, "delete of $sig returns undef";
+}