This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use SvUPGRADE, not sv_upgrade, in sv_sethek
authorFather Chrysostomos <sprout@cpan.org>
Fri, 4 Nov 2011 07:17:52 +0000 (00:17 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 4 Nov 2011 07:17:52 +0000 (00:17 -0700)
This was causing some interesting HTML::Element failures, which were
only triggered by HTML::DOM’s test suite.

ref’s TARG can become tainted if another op in the same statement
turns on tainting for the rest of the statement, so it becomes a PVMG.
The next call to the same ref will try to sv_upgrade it to a PV (which
is lower).  Only the macro version, SvUPGRADE, checks whether the
upgrade is needed.

ref only calls sv_sethek when it has a blessed object for its argu-
ment, hence the strange-looking test.

sv.c
t/op/taint.t

diff --git a/sv.c b/sv.c
index 21b5c2a..6322c25 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4617,7 +4617,7 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek)
             return;
        }
         {
-           sv_upgrade(sv, SVt_PV);
+           SvUPGRADE(sv, SVt_PV);
            sv_usepvn_flags(sv, (char *)HEK_KEY(share_hek_hek(hek)), HEK_LEN(hek), SV_HAS_TRAILING_NUL);
            SvLEN_set(sv, 0);
            SvREADONLY_on(sv);
index ba32722..39a2925 100644 (file)
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 786;
+plan tests => 787;
 
 $| = 1;
 
@@ -2169,6 +2169,12 @@ end
 ok "M$TAINT" ~~ ['m', 'M'], '$tainted ~~ ["whatever", "match"]';
 ok !("M$TAINT" ~~ ['m', undef]), '$tainted ~~ ["whatever", undef]';
 
+# Tainted values and ref()
+for(1,2) {
+  my $x = bless \"M$TAINT", ref(bless[], "main");
+}
+pass("no death when TARG of ref is tainted");
+
 
 # This may bomb out with the alarm signal so keep it last
 SKIP: {