In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/05a1a0145d15cec87e1ea2fd2386895cc1658eb3?hp=3a3e1efce7f28011ce73f2f824c0114319c32573>

- Log -----------------------------------------------------------------
commit 05a1a0145d15cec87e1ea2fd2386895cc1658eb3
Author: Tony Cook <[email protected]>
Date:   Sun Mar 11 14:38:57 2012 +1100

    [rt #111654] properly propgate tainted errors
    
    A magic value (such as a tainted string) may not have POK set, so call
    SvPV() to find out if there's something in ERRSV to report.
    
    Possibly this should be using SvPV_nomg(), but this is the first
    request for magic in this code.  Maybe the code above should be
    calling SvGETMAGIC() before checking SvROK().

M       pp_sys.c
M       t/op/taint.t

commit af89892edf2ed1bf0c26d1b75e74d81410d8c81f
Author: Tony Cook <[email protected]>
Date:   Sun Mar 11 14:27:29 2012 +1100

    [rt #111654] TODO test for tainted die propagation

M       t/op/taint.t
-----------------------------------------------------------------------

Summary of changes:
 pp_sys.c     |    2 +-
 t/op/taint.t |   10 +++++++++-
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/pp_sys.c b/pp_sys.c
index 63fbd05..49910d2 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -500,7 +500,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 1b75439..9cea740 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 793;
+plan tests => 794;
 
 $| = 1;
 
@@ -2197,6 +2197,14 @@ pass("no death when TARG of ref is tainted");
     is_tainted "\F$utf8", "under locale, \\Futf8 taints the result";
 }
 
+{ # 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: {
     skip "No alarm()"  unless $Config{d_alarm};

--
Perl5 Master Repository

Reply via email to