This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix documentation of WITH_LC_NUMERIC_foo
[perl5.git] / pp_pack.c
index 044ea7f..33cb086 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -45,11 +45,11 @@ typedef struct tempsym {
   const char*    grpbeg;   /* 1st char of ()-group  */
   const char*    grpend;   /* end of ()-group       */
   I32      code;     /* template code (!<>)   */
-  I32      length;   /* length/repeat count   */
-  howlen_t howlen;   /* how length is given   */ 
-  int      level;    /* () nesting level      */
   U32      flags;    /* /=4, comma=2, pack=1  */
                      /*   and group modifiers */
+  SSize_t  length;   /* length/repeat count   */
+  howlen_t howlen;   /* how length is given   */ 
+  int      level;    /* () nesting level      */
   STRLEN   strbeg;   /* offset of group start */
   struct tempsym *previous; /* previous group */
 } tempsym_t;
@@ -112,21 +112,17 @@ typedef union {
 /* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
    --jhi Feb 1999 */
 
-#if U16SIZE > SIZE16 || U32SIZE > SIZE32
-#  if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    /* little-endian */
-#    define OFF16(p)   ((char*)(p))
-#    define OFF32(p)   ((char*)(p))
-#  else
-#    if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /* big-endian */
-#      define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16))
-#      define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32))
-#    else
-       ++++ bad cray byte order
-#    endif
-#  endif
-#else
+#if U16SIZE <= SIZE16 && U32SIZE <= SIZE32
 #  define OFF16(p)     ((char *) (p))
 #  define OFF32(p)     ((char *) (p))
+#elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    /* little-endian */
+#  define OFF16(p)     ((char*)(p))
+#  define OFF32(p)     ((char*)(p))
+#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /* big-endian */
+#  define OFF16(p)     ((char*)(p) + (sizeof(U16) - SIZE16))
+#  define OFF32(p)     ((char*)(p) + (sizeof(U32) - SIZE32))
+#else
+#  error "bad cray byte order"
 #endif
 
 #define PUSH16(utf8, cur, p, needs_swap)                        \
@@ -195,7 +191,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
 
   PERL_ARGS_ASSERT_MUL128;
 
-  if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
+  if (! memBEGINs(s, len, "0000")) {  /* need to grow sv */
     SV * const tmpNew = newSVpvs("0000000000");
 
     sv_catsv(tmpNew, sv);
@@ -251,12 +247,15 @@ STATIC U8
 utf8_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
 {
     STRLEN retlen;
-    UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
+    UV val;
+
+    if (*s >= end) {
+       goto croak;
+    }
+    val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-    /* We try to process malformed UTF-8 as much as possible (preferably with
-       warnings), but these two mean we make no progress in the string and
-       might enter an infinite loop */
-    if (retlen == (STRLEN) -1 || retlen == 0)
+    if (retlen == (STRLEN) -1)
+      croak:
        Perl_croak(aTHX_ "Malformed UTF-8 string in '%c' format in unpack",
                   (int) TYPE_NO_MODIFIERS(datumtype));
     if (val >= 0x100) {
@@ -274,7 +273,7 @@ utf8_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
        *(U8 *)(s)++)
 
 STATIC bool
-S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len, I32 datumtype)
+S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t buf_len, I32 datumtype)
 {
     UV val;
     STRLEN retlen;
@@ -290,8 +289,8 @@ S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_
     for (;buf_len > 0; buf_len--) {
        if (from >= end) return FALSE;
        val = utf8n_to_uvchr((U8 *) from, end-from, &retlen, flags);
-       if (retlen == (STRLEN) -1 || retlen == 0) {
-           from += UTF8SKIP(from);
+       if (retlen == (STRLEN) -1) {
+           from += UTF8_SAFE_SKIP(from, end);
            bad |= 1;
        } else from += retlen;
        if (val >= 0x100) {
@@ -308,7 +307,7 @@ S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_
        if (bad & 1) {
            /* Rewalk the string fragment while warning */
            const char *ptr;
-           const int flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+           const U32 flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
            for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) {
                if (ptr >= end) break;
                utf8n_to_uvchr((U8 *) ptr, end-ptr, &retlen, flags);
@@ -358,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);           \
     }                                          \
@@ -372,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));     \
@@ -396,7 +412,7 @@ STMT_START {                                                        \
     STRLEN retlen;                                             \
     if (str >= end) break;                                     \
     val = utf8n_to_uvchr((U8 *) str, end-str, &retlen, utf8_flags);    \
-    if (retlen == (STRLEN) -1 || retlen == 0) {                        \
+    if (retlen == (STRLEN) -1) {                               \
        *cur = '\0';                                            \
        Perl_croak(aTHX_ "Malformed UTF-8 string in pack");     \
     }                                                          \
@@ -409,16 +425,15 @@ static const char *_action( const tempsym_t* symptr )
 }
 
 /* Returns the sizeof() struct described by pat */
-STATIC I32
+STATIC SSize_t
 S_measure_struct(pTHX_ tempsym_t* symptr)
 {
-    I32 total = 0;
+    SSize_t total = 0;
 
     PERL_ARGS_ASSERT_MEASURE_STRUCT;
 
     while (next_symbol(symptr)) {
-       I32 len;
-       int size;
+       SSize_t len, size;
 
         switch (symptr->howlen) {
          case e_star:
@@ -433,7 +448,7 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 
        size = packprops[TYPE_NO_ENDIANNESS(symptr->code)] & PACK_SIZE_MASK;
        if (!size) {
-            int star;
+            SSize_t star;
            /* endianness doesn't influence the size of a type */
            switch(TYPE_NO_ENDIANNESS(symptr->code)) {
            default:
@@ -552,16 +567,17 @@ S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
  * Advances char pointer to 1st non-digit char and returns number
  */
 STATIC const char *
-S_get_num(pTHX_ const char *patptr, I32 *lenptr )
+S_get_num(pTHX_ const char *patptr, SSize_t *lenptr )
 {
-  I32 len = *patptr++ - '0';
+  SSize_t len = *patptr++ - '0';
 
   PERL_ARGS_ASSERT_GET_NUM;
 
   while (isDIGIT(*patptr)) {
-    if (len >= 0x7FFFFFFF/10)
+    SSize_t nlen = (len * 10) + (*patptr++ - '0');
+    if (nlen < 0 || nlen/10 != len)
       Perl_croak(aTHX_ "pack/unpack repeat count overflow");
-    len = (len * 10) + (*patptr++ - '0');
+    len = nlen;
   }
   *lenptr = len;
   return patptr;
@@ -809,7 +825,7 @@ example).
 
 =cut */
 
-I32
+SSize_t
 Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, const char *strend, U32 flags)
 {
     tempsym_t sym;
@@ -835,17 +851,17 @@ Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, cons
     return unpack_rec(&sym, s, s, strend, NULL );
 }
 
-STATIC I32
+STATIC SSize_t
 S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
 {
     dSP;
     SV *sv = NULL;
-    const I32 start_sp_offset = SP - PL_stack_base;
+    const SSize_t start_sp_offset = SP - PL_stack_base;
     howlen_t howlen;
-    I32 checksum = 0;
+    SSize_t checksum = 0;
     UV cuv = 0;
     NV cdouble = 0.0;
-    const int bits_in_uv = CHAR_BIT * sizeof(cuv);
+    const SSize_t bits_in_uv = CHAR_BIT * sizeof(cuv);
     bool beyond = FALSE;
     bool explicit_length;
     const bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
@@ -857,7 +873,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 
     while (next_symbol(symptr)) {
        packprops_t props;
-       I32 len;
+       SSize_t len;
         I32 datumtype = symptr->code;
         bool needs_swap;
        /* do first one only unless in list context
@@ -885,8 +901,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
        props = packprops[TYPE_NO_ENDIANNESS(datumtype)];
        if (props) {
            /* props nonzero means we can process this letter. */
-            const long size = props & PACK_SIZE_MASK;
-            const long howmany = (strend - s) / size;
+            const SSize_t size = props & PACK_SIZE_MASK;
+            const SSize_t howmany = (strend - s) / size;
            if (len > howmany)
                len = howmany;
 
@@ -977,7 +993,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                len = 1;
            if (utf8) {
                const char *hop, *last;
-               I32 l = len;
+               SSize_t l = len;
                hop = last = strbeg;
                while (hop < s) {
                    hop += UTF8SKIP(hop);
@@ -1011,7 +1027,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            }
            break;
        case 'x' | TYPE_IS_SHRIEKING: {
-            I32 ai32;
+            SSize_t ai32;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len;
@@ -1046,7 +1062,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                goto W_checksum;
            }
            if (utf8) {
-               I32 l;
+               SSize_t l;
                const char *hop;
                for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) {
                    if (hop >= strend) {
@@ -1073,9 +1089,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                /* 'A' strips both nulls and spaces */
                const char *ptr;
                if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) {
-                   for (ptr = s+len-1; ptr >= s; ptr--)
-                       if (*ptr != 0 && !UTF8_IS_CONTINUATION(*ptr) &&
-                           !isSPACE_utf8(ptr)) break;
+                    for (ptr = s+len-1; ptr >= s; ptr--) {
+                        if (   *ptr != 0
+                            && !UTF8_IS_CONTINUATION(*ptr)
+                            && !isSPACE_utf8_safe(ptr, strend))
+                        {
+                            break;
+                        }
+                    }
                    if (ptr >= s) ptr += UTF8SKIP(ptr);
                    else ptr++;
                    if (ptr > s+len)
@@ -1135,7 +1156,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            str = SvPVX(sv);
            if (datumtype == 'b') {
                U8 bits = 0;
-               const I32 ai32 = len;
+               const SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 7) bits >>= 1;
                    else if (utf8) {
@@ -1146,7 +1167,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                }
            } else {
                U8 bits = 0;
-               const I32 ai32 = len;
+               const SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 7) bits <<= 1;
                    else if (utf8) {
@@ -1174,7 +1195,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            }
            if (datumtype == 'h') {
                U8 bits = 0;
-               I32 ai32 = len;
+               SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 1) bits >>= 4;
                    else if (utf8) {
@@ -1186,7 +1207,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                }
            } else {
                U8 bits = 0;
-               const I32 ai32 = len;
+               const SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 1) bits <<= 4;
                    else if (utf8) {
@@ -1220,7 +1241,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    STRLEN retlen;
                    aint = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                 ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   if (retlen == (STRLEN) -1)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                  }
@@ -1243,7 +1264,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    STRLEN retlen;
                    const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   if (retlen == (STRLEN) -1)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                    if (!checksum)
@@ -1284,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
@@ -1305,7 +1326,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                                                        strend - s,
                                                        &retlen,
                                                        UTF8_ALLOW_DEFAULT));
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   if (retlen == (STRLEN) -1)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                }
@@ -1357,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)
@@ -1567,7 +1587,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
        case 'w':
            {
                UV auv = 0;
-               U32 bytes = 0;
+               size_t bytes = 0;
 
                while (len > 0 && s < strend) {
                    U8 ch;
@@ -1585,7 +1605,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    if (++bytes >= sizeof(UV)) {        /* promote to string */
                        const char *t;
 
-                       sv = Perl_newSVpvf(aTHX_ "%.*"UVuf, (int)TYPE_DIGITS(UV), auv);
+                       sv = Perl_newSVpvf(aTHX_ "%.*" UVuf,
+                                                 (int)TYPE_DIGITS(UV), auv);
                        while (s < strend) {
                            ch = SHIFT_BYTE(utf8, s, strend, datumtype);
                            sv = mul128(sv, (U8)(ch & 0x7f));
@@ -1705,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
@@ -1826,14 +1850,14 @@ PP(pp_unpack)
 {
     dSP;
     dPOPPOPssrl;
-    I32 gimme = GIMME_V;
+    U8 gimme = GIMME_V;
     STRLEN llen;
     STRLEN rlen;
     const char *pat = SvPV_const(left,  llen);
     const char *s   = SvPV_const(right, rlen);
     const char *strend = s + rlen;
     const char *patend = pat + llen;
-    I32 cnt;
+    SSize_t cnt;
 
     PUTBACK;
     cnt = unpackstring(pat, patend, s, strend,
@@ -1847,7 +1871,7 @@ PP(pp_unpack)
 }
 
 STATIC U8 *
-doencodes(U8 *h, const U8 *s, I32 len)
+doencodes(U8 *h, const U8 *s, SSize_t len)
 {
     *h++ = PL_uuemap[len];
     while (len > 2) {
@@ -2063,9 +2087,9 @@ S_sv_check_infnan(pTHX_ SV *sv, I32 datumtype)
        const I32 c = TYPE_NO_MODIFIERS(datumtype);
        const NV nv = SvNV_nomg(sv);
        if (c == 'w')
-           Perl_croak(aTHX_ "Cannot compress %"NVgf" in pack", nv);
+           Perl_croak(aTHX_ "Cannot compress %" NVgf " in pack", nv);
        else
-           Perl_croak(aTHX_ "Cannot pack %"NVgf" with '%c'", nv, (int) c);
+           Perl_croak(aTHX_ "Cannot pack %" NVgf " with '%c'", nv, (int) c);
     }
     return sv;
 }
@@ -2080,7 +2104,7 @@ SV **
 S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 {
     tempsym_t lookahead;
-    I32 items  = endlist - beglist;
+    SSize_t items  = endlist - beglist;
     bool found = next_symbol(symptr);
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
     bool warn_utf8 = ckWARN(WARN_UTF8);
@@ -2098,7 +2122,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
     while (found) {
        SV *fromstr;
        STRLEN fromlen;
-       I32 len;
+       SSize_t len;
        SV *lengthcode = NULL;
         I32 datumtype = symptr->code;
         howlen_t howlen = symptr->howlen;
@@ -2126,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);
            }
         }
 
@@ -2246,7 +2270,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                len = 1;
            if (utf8) {
                char *hop, *last;
-               I32 l = len;
+               SSize_t l = len;
                hop = last = start;
                while (hop < cur) {
                    hop += UTF8SKIP(hop);
@@ -2295,7 +2319,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            }
            break;
        case 'x' | TYPE_IS_SHRIEKING: {
-           I32 ai32;
+           SSize_t ai32;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) ai32 = utf8_length((U8 *) start, (U8 *) cur) % len;
@@ -2331,7 +2355,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                s = aptr;
                end = aptr + fromlen;
                fromlen = datumtype == 'Z' ? len-1 : len;
-               while ((I32) fromlen > 0 && s < end) {
+               while ((SSize_t) fromlen > 0 && s < end) {
                    s += UTF8SKIP(s);
                    fromlen--;
                }
@@ -2355,8 +2379,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (!S_utf8_to_bytes(aTHX_ &aptr, end, cur, fromlen,
                                  datumtype | TYPE_IS_PACK))
                    Perl_croak(aTHX_ "panic: predicted utf8 length not available, "
-                              "for '%c', aptr=%p end=%p cur=%p, fromlen=%"UVuf,
-                              (int)datumtype, aptr, end, cur, (UV)fromlen);
+                              "for '%c', aptr=%p end=%p cur=%p, fromlen=%zu",
+                              (int)datumtype, aptr, end, cur, fromlen);
                cur += fromlen;
                len -= fromlen;
            } else if (utf8) {
@@ -2364,7 +2388,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
-               if (len <= (I32) fromlen) {
+               if (len <= (SSize_t) fromlen) {
                    fromlen = len;
                    if (datumtype == 'Z' && fromlen > 0) fromlen--;
                }
@@ -2384,7 +2408,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
-               if (len <= (I32) fromlen) {
+               if (len <= (SSize_t) fromlen) {
                    fromlen = len;
                    if (datumtype == 'Z' && fromlen > 0) fromlen--;
                }
@@ -2401,7 +2425,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        case 'B':
        case 'b': {
            const char *str, *end;
-           I32 l, field_len;
+           SSize_t l, field_len;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
@@ -2419,7 +2443,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (howlen == e_star) len = fromlen;
            field_len = (len+7)/8;
            GROWING(utf8, cat, start, cur, field_len);
-           if (len > (I32)fromlen) len = fromlen;
+           if (len > (SSize_t)fromlen) len = fromlen;
            bits = 0;
            l = 0;
            if (datumtype == 'B')
@@ -2470,7 +2494,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        case 'H':
        case 'h': {
            const char *str, *end;
-           I32 l, field_len;
+           SSize_t l, field_len;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
@@ -2488,7 +2512,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (howlen == e_star) len = fromlen;
            field_len = (len+1)/2;
            GROWING(utf8, cat, start, cur, field_len);
-           if (!utf8_source && len > (I32)fromlen) len = fromlen;
+           if (!utf8_source && len > (SSize_t)fromlen) len = fromlen;
            bits = 0;
            l = 0;
            if (datumtype == 'H')
@@ -2581,17 +2605,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (in_bytes) auv = auv % 0x100;
                if (utf8) {
                  W_utf8:
-                   if (cur > end) {
+                   if (cur >= end) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
 
                        GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
-                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur,
-                                                      auv,
-                                                      warn_utf8 ?
-                                                      0 : UNICODE_ALLOW_ANY);
+                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur, auv, 0);
                } else {
                    if (auv >= 0x100) {
                        if (!SvUTF8(cat)) {
@@ -2641,10 +2662,8 @@ 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;
-                   endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv),
-                                              warn_utf8 ?
-                                              0 : UNICODE_ALLOW_ANY);
+                   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';
                        SvCUR_set(cat, cur - start);
@@ -2660,9 +2679,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                        GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
-                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur, UNI_TO_NATIVE(auv),
-                                                      warn_utf8 ?
-                                                      0 : UNICODE_ALLOW_ANY);
+                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur,
+                                                       UNI_TO_NATIVE(auv),
+                                                      0);
                }
            }
            break;
@@ -2674,7 +2693,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
@@ -2684,15 +2703,17 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+#  if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
                if(Perl_isnan(anv))
                    afloat = (float)NV_NAN;
                else
-#endif
+#  endif
+#  ifdef NV_INF
                 /* a simple cast to float is undefined if outside
                  * the range of values that can be represented */
                afloat = (float)(anv >  FLT_MAX ?  NV_INF :
                                  anv < -FLT_MAX ? -NV_INF : anv);
+#  endif
 # endif
                 PUSH_VAR(utf8, cur, afloat, needs_swap);
            }
@@ -2703,7 +2724,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
@@ -3040,7 +3061,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
-                   if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
+                   if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1)
+                        || (SvPADTMP(fromstr) &&
                             !SvREADONLY(fromstr)))) {
                        Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
                                       "Attempt to pack pointer to temporary value");
@@ -3074,10 +3096,10 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2);
            while (fromlen > 0) {
                U8 *end;
-               I32 todo;
+               SSize_t todo;
                U8 hunk[1+63/3*4+1];
 
-               if ((I32)fromlen > len)
+               if ((SSize_t)fromlen > len)
                    todo = len;
                else
                    todo = fromlen;
@@ -3088,8 +3110,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
                        Perl_croak(aTHX_ "panic: string is shorter than advertised, "
-                                  "aptr=%p, aend=%p, buffer=%p, todo=%ld",
-                                  aptr, aend, buffer, (long) todo);
+                                  "aptr=%p, aend=%p, buffer=%p, todo=%zd",
+                                  aptr, aend, buffer, todo);
                    }
                    end = doencodes(hunk, (const U8 *)buffer, todo);
                } else {
@@ -3122,11 +3144,26 @@ PP(pp_pack)
     const char *patend = pat + fromlen;
 
     MARK++;
-    sv_setpvs(cat, "");
+    SvPVCLEAR(cat);
     SvUTF8_off(cat);
 
     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);