Upgrade to CPAN-1.88_53.

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

diff --git a/doop.c b/doop.c
index 45437e1..1620465 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -648,7 +648,7 @@ Perl_do_trans(pTHX_ SV *sv)
 }
 
 void
-Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp)
+Perl_do_join(pTHX_ register SV *sv, SV *delim, register SV **mark, register SV **sp)
 {
     dVAR;
     SV ** const oldmark = mark;
@@ -656,7 +656,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
     register STRLEN len;
     STRLEN delimlen;
 
-    (void) SvPV_const(del, delimlen); /* stringify and get the delimlen */
+    (void) SvPV_const(delim, delimlen); /* stringify and get the delimlen */
     /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */
 
     mark++;
@@ -693,7 +693,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
 
     if (delimlen) {
        for (; items > 0; items--,mark++) {
-           sv_catsv(sv,del);
+           sv_catsv(sv,delim);
            sv_catsv(sv,*mark);
        }
     }
@@ -1173,19 +1173,38 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     STRLEN lensave;
     const char *lsave;
     const char *rsave;
-    const bool left_utf = DO_UTF8(left);
-    const bool right_utf = DO_UTF8(right);
+    bool left_utf;
+    bool right_utf;
     STRLEN needlen = 0;
 
-    if (left_utf && !right_utf)
-       sv_utf8_upgrade(right);
-    else if (!left_utf && right_utf)
-       sv_utf8_upgrade(left);
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
        sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
     lsave = lc = SvPV_nomg_const(left, leftlen);
     rsave = rc = SvPV_nomg_const(right, rightlen);
+
+    /* This need to come after SvPV to ensure that string overloading has
+       fired off.  */
+
+    left_utf = DO_UTF8(left);
+    right_utf = DO_UTF8(right);
+
+    if (left_utf && !right_utf) {
+       /* Avoid triggering overloading again by using temporaries.
+          Maybe there should be a variant of sv_utf8_upgrade that takes pvn
+       */
+       right = sv_2mortal(newSVpvn(rsave, rightlen));
+       sv_utf8_upgrade(right);
+       rsave = rc = SvPV_nomg_const(right, rightlen);
+       right_utf = TRUE;
+    }
+    else if (!left_utf && right_utf) {
+       left = sv_2mortal(newSVpvn(lsave, leftlen));
+       sv_utf8_upgrade(left);
+       lsave = lc = SvPV_nomg_const(left, leftlen);
+       left_utf = TRUE;
+    }
+
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
     SvCUR_set(sv, len);
@@ -1406,8 +1425,11 @@ Perl_do_kv(pTHX)
            RETURN;
        }
 
-       if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied))
+       if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied) 
+           && ! SvTIED_mg((SV*)keys, PERL_MAGIC_regdata_names))
+       {
            i = HvKEYS(keys);
+       }
        else {
            i = 0;
            while (hv_iternext(keys)) i++;