This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document INTMAX_C, UINTMAX_C
[perl5.git] / pp_pack.c
index 5f1a599..53d63f9 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -212,8 +212,9 @@ S_mul128(pTHX_ SV *sv, U8 m)
 
 /* Explosives and implosives. */
 
-#define ISUUCHAR(ch)    (NATIVE_TO_LATIN1(ch) >= NATIVE_TO_LATIN1(' ')  \
-                      && NATIVE_TO_LATIN1(ch) <  NATIVE_TO_LATIN1('a'))
+#define ISUUCHAR(ch)    inRANGE(NATIVE_TO_LATIN1(ch),               \
+                                NATIVE_TO_LATIN1(' '),              \
+                                NATIVE_TO_LATIN1('a') - 1)
 
 /* type modifiers */
 #define TYPE_IS_SHRIEKING      0x100
@@ -290,7 +291,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) {
@@ -1779,9 +1780,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
        } /* End of switch */
 
        if (checksum) {
-           if (strchr("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
+           if (memCHRs("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
              (checksum > bits_in_uv &&
-              strchr("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
+              memCHRs("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
                NV trouble, anv;
 
                 anv = (NV) (1 << (checksum & 15));
@@ -1807,7 +1808,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            }
            else {
                if (checksum < bits_in_uv) {
-                   UV mask = ((UV)1 << checksum) - 1;
+                   UV mask = nBIT_MASK(checksum);
                    cuv &= mask;
                }
                sv = newSVuv(cuv);
@@ -2135,7 +2136,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
         switch (howlen) {
          case e_star:
-           len = strchr("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
+           len = memCHRs("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
                0 : items;
            break;
          default:
@@ -2160,7 +2161,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        if (symptr->flags & FLAG_SLASH) {
            IV count;
            if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack");
-           if (strchr("aAZ", lookahead.code)) {
+           if (memCHRs("aAZ", lookahead.code)) {
                if (lookahead.howlen == e_number) count = lookahead.length;
                else {
                    if (items > 0) {
@@ -3149,6 +3150,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);