change #22071 (taint bug in $^0) introduced a potential double

[p5sagit/p5-mst-13.2.git] / doop.c

diff --git a/doop.c b/doop.c
index 91c7ae1..47d64cb 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -17,10 +17,8 @@
 #include "perl.h"
 
 #ifndef PERL_MICRO
-#if !defined(NSIG) || defined(M_UNIX) || defined(__unix) || defined(M_XENIX)
 #include <signal.h>
 #endif
-#endif
 
 STATIC I32
 S_do_trans_simple(pTHX_ SV *sv)
@@ -617,7 +615,9 @@ Perl_do_trans(pTHX_ SV *sv)
 
     DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
 
-    switch (PL_op->op_private & ~hasutf & 63) {
+    switch (PL_op->op_private & ~hasutf & (
+               OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|
+               OPpTRANS_SQUASH|OPpTRANS_DELETE|OPpTRANS_COMPLEMENT)) {
     case 0:
        if (hasutf)
            return do_trans_simple_utf8(sv);
@@ -669,7 +669,11 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
        ++mark;
     }
 
-    sv_setpv(sv, "");
+    sv_setpvn(sv, "", 0);
+    /* sv_setpv retains old UTF8ness [perl #24846] */
+    if (SvUTF8(sv))
+       SvUTF8_off(sv);
+
     if (PL_tainting && SvMAGICAL(sv))
        SvTAINTED_off(sv);
 
@@ -1004,6 +1008,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
     STRLEN len;
     STRLEN n_a;
     char *s;
+    char *temp_buffer = NULL;
 
     if (RsSNARF(PL_rs))
        return 0;
@@ -1055,6 +1060,27 @@ Perl_do_chomp(pTHX_ register SV *sv)
        else {
            STRLEN rslen;
            char *rsptr = SvPV(PL_rs, rslen);
+           if (SvUTF8(PL_rs) != SvUTF8(sv)) {
+               /* Assumption is that rs is shorter than the scalar.  */
+               if (SvUTF8(PL_rs)) {
+                   /* RS is utf8, scalar is 8 bit.  */
+                   bool is_utf8 = TRUE;
+                   temp_buffer = (char*)bytes_from_utf8((U8*)rsptr,
+                                                        &rslen, &is_utf8);
+                   if (is_utf8) {
+                       /* Cannot downgrade, therefore cannot possibly match
+                        */
+                       assert (temp_buffer == rsptr);
+                       temp_buffer = NULL;
+                       goto nope;
+                   }
+                   rsptr = temp_buffer;
+               } else {
+                   /* RS is 8 bit, scalar is utf8.  */
+                   temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen);
+                   rsptr = temp_buffer;
+               }
+           }
            if (rslen == 1) {
                if (*s != *rsptr)
                    goto nope;
@@ -1077,6 +1103,7 @@ Perl_do_chomp(pTHX_ register SV *sv)
        SvSETMAGIC(sv);
     }
   nope:
+    Safefree(temp_buffer);
     return count;
 }
 
@@ -1108,8 +1135,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
        sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
-    lsave = lc = SvPV(left, leftlen);
-    rsave = rc = SvPV(right, rightlen);
+    lsave = lc = SvPV_nomg(left, leftlen);
+    rsave = rc = SvPV_nomg(right, rightlen);
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
     if ((left_utf || right_utf) && (sv == left || sv == right)) {
@@ -1118,7 +1145,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     }
     else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
        STRLEN n_a;
-       dc = SvPV_force(sv, n_a);
+       dc = SvPV_force_nomg(sv, n_a);
        if (SvCUR(sv) < (STRLEN)len) {
            dc = SvGROW(sv, (STRLEN)(len + 1));
            (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);