This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
tr///; simplify $utf8 =~ tr/nonutf8/nonutf8/
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 2fc4d94..4ea83d1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6344,8 +6344,9 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     I32 j;
     I32 grows = 0;
     OPtrans_map *tbl;
+    SSize_t struct_size; /* malloced size of table struct */
 
-    const I32 complement = o->op_private & OPpTRANS_COMPLEMENT;
+    const bool complement = cBOOL(o->op_private & OPpTRANS_COMPLEMENT);
     const I32 squash     = o->op_private & OPpTRANS_SQUASH;
     I32 del              = o->op_private & OPpTRANS_DELETE;
     SV* swash;
@@ -6611,35 +6612,43 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        goto warnins;
     }
 
-    /* Non-utf8 case: set o->op_pv to point to a simple 256-entry lookup
+    /* Non-utf8 case: set o->op_pv to point to a simple 256entry lookup
      * table. Entries with the value -1 indicate chars not to be
      * translated, while -2 indicates a search char without a
      * corresponding replacement char under /d.
      *
-     * With /c, an extra length arg is stored at the end of the table to
-     * indicate the number of chars in the replacement string, plus any
-     * excess replacement chars not paired with search chars. The extra
-     * chars are needed for utf8 strings. For example,
-     * tr/\x00-\xfd/abcd/c is logically equivalent to
-     * tr/\xfe\xff\x{100}\x{101}.../abcdddd.../, so the c,d chars need to
-     * be kept even though they aren't paired with any chars in the table
-     * (which represents chars \x00-\xff). Even without excess chars, the
-     * last replacement char needs to be kept.
+     * Normally, the table has 256 slots. However, in the presence of
+     * /c, the search charlist has an implicit \x{100}-\x{7fffffff}
+     * added, and if there are enough replacement chars to start pairing
+     * with the \x{100},... search chars, then a larger (> 256) table
+     * is allocated.
+     *
+     * In addition, regardless of whether under /c, an extra slot at the
+     * end is used to store the final repeating char, or -3 under an empty
+     * replacement list, or -2 under /d; which makes the runtime code
+     * easier.
      *
      * The toker will have already expanded char ranges in t and r.
      */
 
-    tbl = (OPtrans_map*)PerlMemShared_calloc(
-                    complement  ? sizeof(OPtrans_map_ex) : sizeof(OPtrans_map),
-                    sizeof(char));
+    /* Initially allocate 257-slot table: 256 for basic (non /c) usage,
+     * plus final slot for repeat/-2/-3. Later we realloc if excess > * 0.
+     * The OPtrans_map struct already contains one slot; hence the -1.
+     */
+    struct_size = sizeof(OPtrans_map) + (256 - 1 + 1)*sizeof(short);
+    tbl = (OPtrans_map*)PerlMemShared_calloc(struct_size, 1);
+    tbl->size = 256;
     cPVOPo->op_pv = (char*)tbl;
 
     if (complement) {
+        SSize_t excess;
+
         /* in this branch, j is a count of 'consumed' (i.e. paired off
          * with a search char) replacement chars (so j <= rlen always)
          */
        for (i = 0; i < (I32)tlen; i++)
            tbl->map[t[i]] = -1;
+
        for (i = 0, j = 0; i < 256; i++) {
            if (!tbl->map[i]) {
                if (j == (I32)rlen) {
@@ -6659,52 +6668,29 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        }
 
         assert(j <= (I32)rlen);
+        excess = rlen - (SSize_t)j;
 
-        /* populate extended portion of table */
-
-       {
-                    /* the repeat char: it may be used to fill the 0x100+
-                     * range. For example,
-                     *     tr/\x00-AE-\xff/bcd/c
-                     * is equivalent to
-                     *     tr/BCD\x{100}-\x{7fffffff}/bcd/
-                     * which is equivalent to
-                     *     tr/BCD\x{100}-\x{7fffffff}/bcddddddddd..../
-                     * So remember the 'd'.
-                     */
-            short   repeat_char;
-            SSize_t excess = rlen - (SSize_t)j;
-            OPtrans_map_ex *extbl = (OPtrans_map_ex*)tbl;
+        if (excess) {
+            /* More replacement chars than search chars:
+             * store excess replacement chars at end of main table.
+             */
 
-           if (excess) {
-                /* More replacement chars than search chars:
-                 * store excess replacement chars at end of main table.
-                 */
+            struct_size += excess;
+            tbl = (OPtrans_map*)PerlMemShared_realloc(tbl,
+                        struct_size + excess * sizeof(short));
+            tbl->size += excess;
+            cPVOPo->op_pv = (char*)tbl;
 
-               extbl = (OPtrans_map_ex *) PerlMemShared_realloc(extbl,
-                            sizeof(OPtrans_map_ex) + excess * sizeof(short));
-               cPVOPo->op_pv = (char*)extbl;
-                for (i = 0; i < (I32)excess; i++)
-                    extbl->map_ex[i] = r[j+i];
-                repeat_char = r[rlen-1];
-           }
-           else {
-                /* no more replacement chars than search chars */
+            for (i = 0; i < (I32)excess; i++)
+                tbl->map[i + 256] = r[j+i];
+        }
+        else {
+            /* no more replacement chars than search chars */
+            if (!rlen && !del && !squash)
+                o->op_private |= OPpTRANS_IDENTICAL;
+        }
 
-                if (rlen)
-                    repeat_char = r[rlen - 1];
-                else {
-                    /* empty replacement list */
-                    repeat_char = 0; /* this value isn't used at runtime */
-                    /* -1 excess count indicates empty replacement charlist */
-                    excess = -1;
-                    if (!(squash | del))
-                        o->op_private |= OPpTRANS_IDENTICAL;
-                }
-           }
-            extbl->excess_len  = excess;      /* excess char count */
-            extbl->repeat_char = (short)repeat_char; /* repeated replace char */
-       }
+        tbl->map[tbl->size] = del ? -2 : rlen ? r[rlen - 1] : -3;
     }
     else {
        if (!rlen && !del) {
@@ -6715,6 +6701,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        else if (!squash && rlen == tlen && memEQ((char*)t, (char*)r, tlen)) {
            o->op_private |= OPpTRANS_IDENTICAL;
        }
+
        for (i = 0; i < 256; i++)
            tbl->map[i] = -1;
        for (i = 0, j = 0; i < (I32)tlen; i++,j++) {
@@ -6733,6 +6720,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                tbl->map[t[i]] = r[j];
            }
        }
+        tbl->map[tbl->size] = del ? -1 : rlen ? -1 : -3;
     }
 
     /* both non-utf8 and utf8 code paths end up here */