properly propagate tainted errors
authorTony Cook <tony@develop-help.com>
Sun, 11 Mar 2012 03:38:57 +0000 (14:38 +1100)
committerRicardo Signes <rjbs@cpan.org>
Thu, 9 Aug 2012 20:04:11 +0000 (16:04 -0400)
Backport af89892ed and 05a1a0145d by Tony Cook to 5.14

Bug: https://rt.perl.org/rt3/Public/Bug/Display.html?id=111654
Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=663158

pp_sys.c
t/op/taint.t

index 3c42133..fbf1124 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -497,7 +497,7 @@ PP(pp_die)
            }
        }
     }
-    else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+    else if (SvPV_const(ERRSV, len), len) {
        exsv = sv_mortalcopy(ERRSV);
        sv_catpvs(exsv, "\t...propagated");
     }
index a300b9b..3a2b5d9 100644 (file)
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 778;
+plan tests => 779;
 
 $| = 1;
 
@@ -2156,7 +2156,13 @@ end
     ok(!tainted "", "tainting still works after index() of the constant");
 }
 
-
+{ # 111654
+  eval {
+    eval { die "Test\n".substr($ENV{PATH}, 0, 0); };
+    die;
+  };
+  like($@, qr/^Test\n\t\.\.\.propagated at /, "error should be propagated");
+}
 
 # This may bomb out with the alarm signal so keep it last
 SKIP: {