Fix documentation of WITH_LC_NUMERIC_foo

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 24cdee9..33cb086 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -290,7 +290,7 @@ S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t
        if (from >= end) return FALSE;
        val = utf8n_to_uvchr((U8 *) from, end-from, &retlen, flags);
        if (retlen == (STRLEN) -1) {
-           from += UTF8SKIP(from);
+           from += UTF8_SAFE_SKIP(from, end);
            bad |= 1;
        } else from += retlen;
        if (val >= 0x100) {
@@ -357,11 +357,28 @@ STMT_START {                                                      \
     }                                                          \
 } STMT_END
 
+#define SAFE_UTF8_EXPAND(var)  \
+STMT_START {                           \
+    if ((var) > SSize_t_MAX / UTF8_EXPAND) \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    (var) = (var) * UTF8_EXPAND; \
+} STMT_END
+
+#define GROWING2(utf8, cat, start, cur, item_size, item_count) \
+STMT_START {                                                   \
+    if (SSize_t_MAX / (item_size) < (item_count))              \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \
+} STMT_END
+
 #define GROWING(utf8, cat, start, cur, in_len) \
 STMT_START {                                   \
     STRLEN glen = (in_len);                    \
-    if (utf8) glen *= UTF8_EXPAND;             \
-    if ((cur) + glen >= (start) + SvLEN(cat)) {        \
+    STRLEN catcur = (STRLEN)((cur) - (start)); \
+    if (utf8) SAFE_UTF8_EXPAND(glen);          \
+    if (SSize_t_MAX - glen < catcur)           \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    if (catcur + glen >= SvLEN(cat)) { \
        (start) = sv_exp_grow(cat, glen);       \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
@@ -371,7 +388,7 @@ STMT_START {                                        \
 STMT_START {                                   \
     const STRLEN glen = (in_len);              \
     STRLEN gl = glen;                          \
-    if (utf8) gl *= UTF8_EXPAND;               \
+    if (utf8) SAFE_UTF8_EXPAND(gl);            \
     if ((cur) + gl >= (start) + SvLEN(cat)) {  \
         *cur = '\0';                           \
         SvCUR_set((cat), (cur) - (start));     \
@@ -1288,7 +1305,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                STRLEN retlen;
                UV auv;
                if (utf8) {
-                   U8 result[UTF8_MAXLEN];
+                   U8 result[UTF8_MAXLEN+1];
                    const char *ptr = s;
                    STRLEN len;
                    /* Bug: warns about bad utf8 even if we are short on bytes
@@ -1361,8 +1378,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 #if SHORTSIZE != SIZE16
            while (len-- > 0) {
                unsigned short aushort;
-                SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap,
-                          needs_swap);
+               SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap);
                if (!checksum)
                    mPUSHu(aushort);
                else if (checksum > bits_in_uv)
@@ -1710,7 +1726,10 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            if (!checksum) {
                 const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
                sv = sv_2mortal(newSV(l));
-               if (l) SvPOK_on(sv);
+               if (l) {
+                    SvPOK_on(sv);
+                    *SvEND(sv) = '\0';
+                }
            }
 
             /* Note that all legal uuencoded strings are ASCII printables, so
@@ -2131,7 +2150,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
                /* We can process this letter. */
                STRLEN size = props & PACK_SIZE_MASK;
-               GROWING(utf8, cat, start, cur, (STRLEN) len * size);
+               GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
            }
         }
 
@@ -2643,7 +2662,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                fromstr = NEXTFROM;
                auv = SvUV_no_inf(fromstr, datumtype);
                if (utf8) {
-                   U8 buffer[UTF8_MAXLEN], *endb;
+                   U8 buffer[UTF8_MAXLEN+1], *endb;
                    endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv), 0);
                    if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
                        *cur = '\0';
@@ -3130,6 +3149,21 @@ PP(pp_pack)
 
     packlist(cat, pat, patend, MARK, SP + 1);
 
+    if (SvUTF8(cat)) {
+        STRLEN result_len;
+        const char * result = SvPV_nomg(cat, result_len);
+        const U8 * error_pos;
+
+        if (! is_utf8_string_loc((U8 *) result, result_len, &error_pos)) {
+            _force_out_malformed_utf8_message(error_pos,
+                                              (U8 *) result + result_len,
+                                              0, /* no flags */
+                                              1 /* Die */
+                                            );
+            NOT_REACHED; /* NOTREACHED */
+        }
+    }
+
     SvSETMAGIC(cat);
     SP = ORIGMARK;
     PUSHs(cat);