[perl #87336] lc/uc(first) fail to taint the returned string

This bug was caused by change 28011 (ec9af7d), which stopped pp_lc
from using sv_setsv_flags, thereby bypassing these two lines at the
end of that function:
    if (SvTAINTED(sstr))
	SvTAINT(dstr);

Change 28012 (6730619) did exactly the same thing to pp_uc.

28013 (d54190f) broke ucfirst and lcfirst.

This commit simply puts that taint logic at the end of the pp_*
functions.

diff --git a/pp.c b/pp.c
index 751a0bf..8b15b6e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4209,6 +4209,8 @@ PP(pp_ucfirst)
            SvCUR_set(dest, need - 1);
        }
     }
+    if (dest != source && SvTAINTED(source))
+       SvTAINT(dest);
     SvSETMAGIC(dest);
     RETURN;
 }
@@ -4479,6 +4481,8 @@ PP(pp_uc)
            SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
        }
     } /* End of isn't utf8 */
+    if (dest != source && SvTAINTED(source))
+       SvTAINT(dest);
     SvSETMAGIC(dest);
     RETURN;
 }
@@ -4701,6 +4705,8 @@ PP(pp_lc)
            SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
        }
     }
+    if (dest != source && SvTAINTED(source))
+       SvTAINT(dest);
     SvSETMAGIC(dest);
     RETURN;
 }

diff --git a/t/op/taint.t b/t/op/taint.t
index c695570..9df6fee 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 770;
+plan tests => 774;
 
 $| = 1;
 
@@ -2131,6 +2131,19 @@ end
            "user-defined property: tainted case");
 }
 
+{
+    # [perl #87336] lc/uc(first) failing to taint the returned string
+    my $source = "foo$TAINT";
+    my $dest = lc $source;
+    is_tainted $dest, "lc(tainted) taints its return value";
+    $dest = lcfirst $source;
+    is_tainted $dest, "lcfirst(tainted) taints its return value";
+    $dest = uc $source;
+    is_tainted $dest, "uc(tainted) taints its return value";
+    $dest = ucfirst $source;
+    is_tainted $dest, "ucfirst(tainted) taints its return value";
+}
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};