Turn of tainting locally inside swash_init(), as the internal

implementation of the regexp engine has nothing to do with user data,
so when and where it happens to call require is agnostic of the current
expression's taintedness.

p4raw-id: //depot/perl@27221

diff --git a/t/op/utftaint.t b/t/op/utftaint.t
index 59dd96f..1294526 100644 (file)
--- a/t/op/utftaint.t
+++ b/t/op/utftaint.t
@@ -18,7 +18,7 @@ sub tainted ($) {
 }
 
 require './test.pl';
-plan(tests => 3*10 + 3*8 + 2*16);
+plan(tests => 3*10 + 3*8 + 2*16 + 2);
 
 my $arg = $ENV{PATH}; # a tainted value
 use constant UTF8 => "\x{1234}";
@@ -143,4 +143,10 @@ for my $ary ([ascii => 'perl'], [latin1 => "\xB6"]) {
     is(tainted($taint), tainted($arg), "tainted: $encode, downgrade down");
 }
 
+fresh_perl_is('$a = substr $^X, 0, 0; /\x{100}/i; /$a\x{100}/i || print q,ok,',
+             'ok', {switches => ["-T", "-l"]},
+             "matching a regexp is taint agnostic");
 
+fresh_perl_is('$a = substr $^X, 0, 0; /$a\x{100}/i || print q,ok,',
+             'ok', {switches => ["-T", "-l"]},
+             "therefore swash_init should be taint agnostic");

diff --git a/utf8.c b/utf8.c
index 992629d..9dc57a2 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1592,6 +1592,10 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     ENTER;
     SAVEI32(PL_hints);
     PL_hints = 0;
+    /* It is assumed that callers of this routine are not passing in any
+       user derived data.  */
+    SAVEBOOL(PL_tainted);
+    PL_tainted = 0;
     save_re_context();
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {     /* demand load utf8 */
        ENTER;