This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Document NV to int cast macros
[perl5.git] / doop.c
diff --git a/doop.c b/doop.c
index 5ac7942..822ad3c 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -46,6 +46,10 @@ S_do_trans_simple(pTHX_ SV * const sv, const OPtrans_map * const tbl)
     U8 * const send = s+len;
 
     PERL_ARGS_ASSERT_DO_TRANS_SIMPLE;
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: entering do_trans_simple:"
+                                          " input sv:\n",
+                                          __FILE__, __LINE__));
+    DEBUG_y(sv_dump(sv));
 
     /* First, take care of non-UTF-8 input strings, because they're easy */
     if (!SvUTF8(sv)) {
@@ -101,6 +105,9 @@ S_do_trans_simple(pTHX_ SV * const sv, const OPtrans_map * const tbl)
        SvUTF8_on(sv);
        SvSETMAGIC(sv);
     }
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: returning %zu\n",
+                                          __FILE__, __LINE__, matches));
+    DEBUG_y(sv_dump(sv));
     return matches;
 }
 
@@ -127,6 +134,11 @@ S_do_trans_count(pTHX_ SV * const sv, const OPtrans_map * const tbl)
 
     PERL_ARGS_ASSERT_DO_TRANS_COUNT;
 
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: entering do_trans_count:"
+                                          " input sv:\n",
+                                          __FILE__, __LINE__));
+    DEBUG_y(sv_dump(sv));
+
     if (!SvUTF8(sv)) {
        while (s < send) {
             if (tbl->map[*s++] >= 0)
@@ -147,6 +159,8 @@ S_do_trans_count(pTHX_ SV * const sv, const OPtrans_map * const tbl)
        }
     }
 
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: count returning %zu\n",
+                                          __FILE__, __LINE__, matches));
     return matches;
 }
 
@@ -170,6 +184,11 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl)
 
     PERL_ARGS_ASSERT_DO_TRANS_COMPLEX;
 
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: entering do_trans_complex:"
+                                          " input sv:\n",
+                                          __FILE__, __LINE__));
+    DEBUG_y(sv_dump(sv));
+
     if (!SvUTF8(sv)) {
        U8 *d = s;
        U8 * const dstart = d;
@@ -191,13 +210,14 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl)
                     }
                }
                else {
-                    if (this_map == (short) TR_UNMAPPED)
+                    if (this_map == (short) TR_UNMAPPED) {
                         *d++ = *s;
+                        previous_map = (short) TR_OOB;
+                    }
                     else {
                         assert(this_map == (short) TR_DELETE);
                         matches++;
                     }
-                    previous_map = (short) TR_OOB;
                 }
 
                s++;
@@ -269,6 +289,7 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl)
             else if (sch == (short) TR_UNMAPPED) {
                 Move(s, d, len, U8);
                 d += len;
+                pch = TR_OOB;
             }
             else if (sch == (short) TR_DELETE)
                 matches++;
@@ -279,7 +300,6 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl)
             }
 
             s += len;
-            pch = TR_OOB;
         }
 
        if (grows) {
@@ -293,6 +313,9 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl)
        SvUTF8_on(sv);
     }
     SvSETMAGIC(sv);
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: returning %zu\n",
+                                          __FILE__, __LINE__, matches));
+    DEBUG_y(sv_dump(sv));
     return matches;
 }
 
@@ -323,6 +346,14 @@ S_do_trans_count_invmap(pTHX_ SV * const sv, AV * const invmap)
 
     PERL_ARGS_ASSERT_DO_TRANS_COUNT_INVMAP;
 
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d:"
+                                          "entering do_trans_count_invmap:"
+                                          " input sv:\n",
+                                          __FILE__, __LINE__));
+    DEBUG_y(sv_dump(sv));
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "mapping:\n"));
+    DEBUG_y(invmap_dump(from_invlist, (UV *) SvPVX(to_invmap_sv)));
+
     s = (U8*)SvPV_nomg(sv, len);
 
     send = s + len;
@@ -356,10 +387,11 @@ S_do_trans_count_invmap(pTHX_ SV * const sv, AV * const invmap)
         s += s_len;
     }
 
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: returning %zu\n",
+                                          __FILE__, __LINE__, matches));
     return matches;
 }
 
-
 /* Helper function for do_trans().
  * Handles cases where an inversion map implementation is to be used and the
  * search and replacement charlists are either not identical or flags are
@@ -390,7 +422,7 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
     const bool delete_unfound = cBOOL(PL_op->op_private & OPpTRANS_DELETE);
     bool inplace = ! cBOOL(PL_op->op_private & OPpTRANS_GROWS);
     const UV* from_array = invlist_array(from_invlist);
-    UV final_map;
+    UV final_map = TR_OOB;
     bool out_is_utf8 = cBOOL(SvUTF8(sv));
     STRLEN s_len;
 
@@ -410,12 +442,16 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
      * assume cannot */
     if (! out_is_utf8 && (PL_op->op_private & OPpTRANS_CAN_FORCE_UTF8)) {
         inplace = FALSE;
-        if (max_expansion < 2) {
-            max_expansion = 2;
-        }
     }
 
     s = (U8*)SvPV_nomg(sv, len);
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: entering do_trans_invmap:"
+                                          " input sv:\n",
+                                          __FILE__, __LINE__));
+    DEBUG_y(sv_dump(sv));
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "mapping:\n"));
+    DEBUG_y(invmap_dump(from_invlist, map));
+
     send = s + len;
     s0 = s;
 
@@ -428,9 +464,10 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
     else {
         /* Here, we can't edit in place.  We have no idea how much, if any,
          * this particular input string will grow.  However, the compilation
-         * calculated the maximum expansion possible.  Use that to allocale
-         * based on the worst case scenario. */
-       Newx(d, len * max_expansion + 1, U8);
+         * calculated the maximum expansion possible.  Use that to allocate
+         * based on the worst case scenario.  (First +1 is to round up; 2nd is
+         * for \0) */
+       Newx(d, (STRLEN) (len * max_expansion + 1 + 1), U8);
        d0 = d;
     }
 
@@ -464,7 +501,7 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
 
         if (to == (UV) TR_UNLISTED) { /* Just copy the unreplaced character */
             if (UVCHR_IS_INVARIANT(from) || ! out_is_utf8) {
-                *d++ = from;
+                *d++ = (U8) from;
             }
             else if (SvUTF8(sv)) {
                 Move(s, d, s_len, U8);
@@ -484,7 +521,6 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
 
         if (to == (UV) TR_SPECIAL_HANDLING) {
             if (delete_unfound) {
-                previous_map = to;
                 s += s_len;
                 continue;
             }
@@ -511,7 +547,7 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
                     matches = 0;
                     goto restart;
                 }
-                *d++ = to;
+                *d++ = (U8) to;
             }
         }
 
@@ -523,6 +559,7 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
     s += s_len;
     if (! inplace) {
        sv_setpvn(sv, (char*)d0, d - d0);
+        Safefree(d0);
     }
     else {
        *d = '\0';
@@ -534,10 +571,12 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap)
     }
     SvSETMAGIC(sv);
 
+    DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: returning %zu\n",
+                                          __FILE__, __LINE__, matches));
+    DEBUG_y(sv_dump(sv));
     return matches;
 }
 
-
 /* Execute a tr//. sv is the value to be translated, while PL_op
  * should be an OP_TRANS or OP_TRANSR op, whose op_pv field contains a
  * translation table or whose op_sv field contains an inversion map.
@@ -689,7 +728,6 @@ Perl_do_sprintf(pTHX_ SV *sv, SSize_t len, SV **sarg)
        SvTAINTED_on(sv);
 }
 
-/* currently converts input to bytes if possible, but doesn't sweat failure */
 UV
 Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
 {
@@ -715,7 +753,8 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
             s = (unsigned char *) SvPV_flags(sv, srclen, svpv_flags);
         }
         else {
-               Perl_croak(aTHX_ "Use of strings with code points over 0xFF as arguments to vec is forbidden");
+            Perl_croak(aTHX_ "Use of strings with code points over 0xFF"
+                             " as arguments to vec is forbidden");
         }
     }
 
@@ -815,7 +854,7 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
        }
     }
     else if (size < 8)
-       retnum = (s[uoffset] >> bitoffs) & ((1 << size) - 1);
+       retnum = (s[uoffset] >> bitoffs) & nBIT_MASK(size);
     else {
        if (size == 8)
            retnum = s[uoffset];
@@ -918,7 +957,7 @@ Perl_do_vecset(pTHX_ SV *sv)
     }
 
     if (size < 8) {
-       mask = (1 << size) - 1;
+       mask = nBIT_MASK(size);
        lval &= mask;
        s[offset] &= ~(mask << bitoffs);
        s[offset] |= lval << bitoffs;
@@ -1048,7 +1087,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     lsave = lc;
     rsave = rc;
 
-    SvCUR_set(sv, len);
     (void)SvPOK_only(sv);
     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
        dc = SvPV_force_nomg_nolen(sv);
@@ -1064,6 +1102,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
        sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
        dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
     }
+    SvCUR_set(sv, len);
 
     if (len >= sizeof(long)*4 &&
        !(PTR2nat(dc) % sizeof(long)) &&
Unnamed repository; edit this file 'description' to name the repository.