Win32 patches for cfgperl from Sarathy.
[p5sagit/p5-mst-13.2.git] / pp_hot.c
index c888ea5..ea2b932 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -146,6 +146,53 @@ PP(pp_concat)
     dPOPTOPssrl;
     STRLEN len;
     char *s;
+    bool left_utf = DO_UTF8(left);
+    bool right_utf = DO_UTF8(right);
+
+    if (left_utf != right_utf) {
+        if (TARG == right && !right_utf) {
+            sv_utf8_upgrade(TARG); /* Now straight binary copy */
+            SvUTF8_on(TARG);
+        }
+        else {
+            /* Set TARG to PV(left), then add right */
+            char *l, *c;
+            STRLEN targlen;
+            if (TARG == right)
+                /* Need a safe copy elsewhere since we're just about to
+                   write onto TARG */
+                s = strdup(SvPV(right,len));
+            else
+                s = SvPV(right,len);
+            l = SvPV(left, targlen);
+            if (TARG != left)
+                sv_setpvn(TARG,l,targlen);
+            if (!left_utf)
+                sv_utf8_upgrade(TARG);
+            /* Extend TARG to length of right (s) */
+            targlen = SvCUR(TARG) + len;
+            if (!right_utf) {
+                /* plus one for each hi-byte char if we have to upgrade */
+                for (c = s; *c; c++)  {
+                    if (*c & 0x80)
+                        targlen++;
+                }
+            }
+            SvGROW(TARG, targlen+1);
+            /* And now copy, maybe upgrading right to UTF8 on the fly */
+            for (c = SvEND(TARG); *s; s++) {
+                 if (*s & 0x80 && !right_utf)
+                     c = (char*)uv_to_utf8((U8*)c, *s);
+                 else
+                     *c++ = *s;
+            }
+            SvCUR_set(TARG, targlen);
+            *SvEND(TARG) = '\0';
+            SvUTF8_on(TARG);
+            SETs(TARG);
+            RETURN;
+        }
+    }
 
     if (TARG != left) {
        s = SvPV(left,len);
@@ -158,10 +205,8 @@ PP(pp_concat)
     }
     else if (SvGMAGICAL(TARG))
        mg_get(TARG);
-    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
+    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG)
        sv_setpv(TARG, "");     /* Suppress warning. */
-       s = SvPV_force(TARG, len);
-    }
     s = SvPV(right,len);
     if (SvOK(TARG)) {
 #if defined(PERL_Y2KWARN)
@@ -176,19 +221,12 @@ PP(pp_concat)
            }
        }
 #endif
-       if (DO_UTF8(right))
-           sv_utf8_upgrade(TARG);
        sv_catpvn(TARG,s,len);
-       if (!IN_BYTE) {
-           if (SvUTF8(right))
-               SvUTF8_on(TARG);
-       }
-       else if (!SvUTF8(right)) {
-           SvUTF8_off(TARG);
-       }
     }
     else
        sv_setpvn(TARG,s,len);  /* suppress warning */
+    if (left_utf)
+       SvUTF8_on(TARG);
     SETTARG;
     RETURN;
   }
@@ -455,7 +493,7 @@ PP(pp_rv2av)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
-               STRLEN n_a;
+               STRLEN len;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -474,13 +512,17 @@ PP(pp_rv2av)
                    }
                    RETSETUNDEF;
                }
-               sym = SvPV(sv,n_a);
+               sym = SvPV(sv,len);
                if ((PL_op->op_flags & OPf_SPECIAL) &&
                    !(PL_op->op_flags & OPf_MOD))
                {
                    gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
-                   if (!gv)
+                   if (!gv
+                       && (!is_gv_magical(sym,len,0)
+                           || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV))))
+                   {
                        RETSETUNDEF;
+                   }
                }
                else {
                    if (PL_op->op_private & HINT_STRICT_REFS)
@@ -555,7 +597,7 @@ PP(pp_rv2hv)
            
            if (SvTYPE(sv) != SVt_PVGV) {
                char *sym;
-               STRLEN n_a;
+               STRLEN len;
 
                if (SvGMAGICAL(sv)) {
                    mg_get(sv);
@@ -574,13 +616,17 @@ PP(pp_rv2hv)
                    }
                    RETSETUNDEF;
                }
-               sym = SvPV(sv,n_a);
+               sym = SvPV(sv,len);
                if ((PL_op->op_flags & OPf_SPECIAL) &&
                    !(PL_op->op_flags & OPf_MOD))
                {
                    gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
-                   if (!gv)
+                   if (!gv
+                       && (!is_gv_magical(sym,len,0)
+                           || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV))))
+                   {
                        RETSETUNDEF;
+                   }
                }
                else {
                    if (PL_op->op_private & HINT_STRICT_REFS)
@@ -1021,7 +1067,8 @@ play_it_again:
             && !PL_sawampersand 
             && ((rx->reganch & ROPT_NOSCAN)
                 || !((rx->reganch & RE_INTUIT_TAIL)
-                     && (r_flags & REXEC_SCREAM))))
+                     && (r_flags & REXEC_SCREAM)))
+            && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
            goto yup;
     }
     if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
@@ -1374,8 +1421,7 @@ Perl_do_readline(pTHX)
 /* delay EOF state for a snarfed empty file */
 #define SNARF_EOF(gimme,rs,io,sv) \
     (gimme != G_SCALAR || SvCUR(sv)                                    \
-     || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE)                     \
-     || ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+     || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
 
     for (;;) {
        if (!sv_gets(sv, fp, offset)
@@ -1408,6 +1454,7 @@ Perl_do_readline(pTHX)
            SvTAINTED_on(sv);
        }
        IoLINES(io)++;
+       IoFLAGS(io) |= IOf_NOLINE;
        SvSETMAGIC(sv);
        XPUSHs(sv);
        if (type == OP_GLOB) {
@@ -1871,7 +1918,7 @@ PP(pp_subst)
            SPAGAIN;
            PUSHs(sv_2mortal(newSViv((I32)iters)));
        }
-       (void)SvPOK_only(TARG);
+       (void)SvPOK_only_UTF8(TARG);
        TAINT_IF(rxtainted);
        if (SvSMAGICAL(TARG)) {
            PUTBACK;
@@ -2643,6 +2690,7 @@ try_autoload:
            cx->blk_sub.savearray = GvAV(PL_defgv);
            GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_THREADS */
+           cx->blk_sub.oldcurpad = PL_curpad;
            cx->blk_sub.argarray = av;
            ++MARK;