[PATCH] extra code in pp_concat, Take 2

[Andy Lester]

On Wed, Apr 13, 2005 at 08:48:35PM -0500, Andy Lester ([EMAIL PROTECTED]) wrote:
> I will adjust accordingly, and also make a patch with that as a test 
> case.

Updated patch, plus added a test case to t/op/concat.t.

xoa


-- 
Andy Lester => [EMAIL PROTECTED] => www.petdance.com => AIM:petdance

--- /home/alester/bleadperl/pp_hot.c    2005-04-11 10:24:29.000000000 -0500
+++ /home/alester/bw/trunk/pp_hot.c     2005-04-13 20:59:03.000000000 -0500
@@ -145,12 +145,11 @@
   dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
   {
     dPOPTOPssrl;
-    STRLEN llen;
-    char* lpv;
     bool lbyte;
     STRLEN rlen;
-    char* rpv = SvPV(right, rlen);     /* mg_get(right) happens here */
-    bool rbyte = !DO_UTF8(right), rcopied = FALSE;
+    const char *rpv = SvPV(right, rlen);       /* mg_get(right) happens here */
+    const bool rbyte = !DO_UTF8(right);
+    bool rcopied = FALSE;
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
@@ -159,7 +158,8 @@
     }
 
     if (TARG != left) {
-       lpv = SvPV(left, llen);         /* mg_get(left) may happen here */
+        STRLEN llen;
+        const char* const lpv = SvPV(left, llen);      /* mg_get(left) may 
happen here */
        lbyte = !DO_UTF8(left);
        sv_setpvn(TARG, lpv, llen);
        if (!lbyte)
@@ -168,11 +168,12 @@
            SvUTF8_off(TARG);
     }
     else { /* TARG == left */
+        STRLEN llen;
        if (SvGMAGICAL(left))
            mg_get(left);               /* or mg_get(left) may happen here */
        if (!SvOK(TARG))
            sv_setpv(left, "");
-       lpv = SvPV_nomg(left, llen);
+       (void)SvPV_nomg(left, llen);    /* Needed to set UTF8 flag */
        lbyte = !DO_UTF8(left);
        if (IN_BYTES)
            SvUTF8_off(TARG);
@@ -2580,7 +2581,7 @@
        }
     }
     else {
-       int type = SvTYPE(dbsv);
+       const int type = SvTYPE(dbsv);
        if (type < SVt_PVIV && type != SVt_IV)
            sv_upgrade(dbsv, SVt_PVIV);
        (void)SvIOK_on(dbsv);
@@ -2601,7 +2602,7 @@
     register CV *cv;
     register PERL_CONTEXT *cx;
     I32 gimme;
-    bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
+    const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
 
     if (!sv)
        DIE(aTHX_ "Not a CODE reference");
@@ -2618,9 +2619,7 @@
        break;
     default:
        if (!SvROK(sv)) {
-           char *sym;
-           STRLEN n_a;
-
+           const char *sym;
            if (sv == &PL_sv_yes) {             /* unfound import, ignore */
                if (hasargs)
                    SP = PL_stack_base + POPMARK;
@@ -2632,8 +2631,10 @@
                    goto got_rv;
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
-           else
+           else {
+                STRLEN n_a;
                sym = SvPV(sv, n_a);
+            }
            if (!sym)
                DIE(aTHX_ PL_no_usym, "a subroutine");
            if (PL_op->op_private & HINT_STRICT_REFS)
@@ -2891,7 +2892,7 @@
         static const char oom_array_extend[] =
              "Out of memory during array extend"; /* Duplicated in av.c */
         if (SvUOK(elemsv)) {
-             UV uv = SvUV(elemsv);
+             const UV uv = SvUV(elemsv);
              elem = uv > IV_MAX ? IV_MAX : uv;
         }
         else if (SvNOK(elemsv))
@@ -2990,13 +2991,12 @@
     SV* ob;
     GV* gv;
     HV* stash;
-    char* name;
     STRLEN namelen;
-    char* packname = 0;
+    const char* packname = 0;
     SV *packsv = Nullsv;
     STRLEN packlen;
+    const char *name = SvPV(meth, namelen);
 
-    name = SvPV(meth, namelen);
     sv = *(PL_stack_base + TOPMARK + 1);
 
     if (!sv)
@@ -3087,9 +3087,9 @@
           cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
           don't want that.
        */
-       char* leaf = name;
-       char* sep = Nullch;
-       char* p;
+       const char* leaf = name;
+       const char* sep = Nullch;
+       const char* p;
 
        for (p = name; *p; p++) {
            if (*p == '\'')
--- /home/alester/bleadperl/t/op/concat.t       2004-02-24 19:55:26.000000000 
-0600
+++ /home/alester/bw/trunk/t/op/concat.t        2005-04-13 20:55:52.000000000 
-0500
@@ -18,7 +18,7 @@
     return $ok;
 }
 
-print "1..28\n";
+print "1..29\n";
 
 ($a, $b, $c) = qw(foo bar);
 
@@ -146,3 +146,9 @@
     ok(($x1 eq $x2),  "perl #26905, left,  .= vs = . in chars");
     ok(($y1 eq $y2),  "perl #26905, right, .= vs = . in chars");
 }
+
+{
+    # Concatenation needs to preserve UTF8ness of left oper.
+    my $x = eval"qr/\x{fff}/";
+    ok( ord chop($x .= "\303\277") == 191, "UTF8ness preserved" );
+}