properly propagate tainted errors

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

diff --git a/pp_sys.c b/pp_sys.c
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");
     }

diff --git a/t/op/taint.t b/t/op/taint.t
index a300b9b..3a2b5d9 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -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: {