Increase $warnings::VERSION to 1.14

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 9ac9e3d..c760f69 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -645,7 +645,7 @@ uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
     STRLEN retlen;
     UV 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 (preferrably with
+    /* 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)
@@ -1660,7 +1660,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            break;
        case 'U':
            if (len == 0) {
-                if (explicit_length) {
+                if (explicit_length && howlen != e_star) {
                    /* Switch to "bytes in UTF-8" mode */
                    if (symptr->flags & FLAG_DO_UTF8) utf8 = 0;
                    else
@@ -1690,10 +1690,10 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    len = UTF8SKIP(result);
                    if (!uni_to_bytes(aTHX_ &ptr, strend,
                                      (char *) &result[1], len-1, 'U')) break;
-                   auv = utf8n_to_uvuni(result, len, &retlen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV);
+                   auv = utf8n_to_uvuni(result, len, &retlen, UTF8_ALLOW_DEFAULT);
                    s = ptr;
                } else {
-                   auv = utf8n_to_uvuni((U8*)s, strend - s, &retlen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV);
+                   auv = utf8n_to_uvuni((U8*)s, strend - s, &retlen, UTF8_ALLOW_DEFAULT);
                    if (retlen == (STRLEN) -1 || retlen == 0)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
@@ -1759,7 +1759,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            }
            break;
 #else
-            /* Fallhrough! */
+            /* Fallthrough! */
 #endif
        case 'v':
        case 'n':
@@ -2234,7 +2234,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 
         if (symptr->flags & FLAG_SLASH){
             if (SP - PL_stack_base - start_sp_offset <= 0)
-                Perl_croak(aTHX_ "'/' must follow a numeric type in unpack");
+               break;
             if( next_symbol(symptr) ){
               if( symptr->howlen == e_number )
                Perl_croak(aTHX_ "Count after length/code in unpack" );
@@ -2455,7 +2455,8 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     if (m != marks + sym_ptr->level+1) {
        Safefree(marks);
        Safefree(to_start);
-       Perl_croak(aTHX_ "panic: marks beyond string end");
+       Perl_croak(aTHX_ "panic: marks beyond string end, m=%p, marks=%p, "
+                  "level=%d", m, marks, sym_ptr->level);
     }
     for (group=sym_ptr; group; group = group->previous)
        group->strbeg = marks[group->level] - to_start;
@@ -2789,7 +2790,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                GROWING(0, cat, start, cur, len);
                if (!uni_to_bytes(aTHX_ &aptr, end, cur, fromlen,
                                  datumtype | TYPE_IS_PACK))
-                   Perl_croak(aTHX_ "panic: predicted utf8 length not available");
+                   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);
                cur += fromlen;
                len -= fromlen;
            } else if (utf8) {
@@ -3184,7 +3187,12 @@ extern const double _double_constants[];
            Zero(&anv, 1, NV); /* can be long double with unused bits */
            while (len-- > 0) {
                fromstr = NEXTFROM;
+#ifdef __GNUC__
+               /* to work round a gcc/x86 bug; don't use SvNV */
+               anv.nv = sv_2nv(fromstr);
+#else
                anv.nv = SvNV(fromstr);
+#endif
                DO_BO_PACK_N(anv, NV);
                PUSH_BYTES(utf8, cur, anv.bytes, sizeof(anv.bytes));
            }
@@ -3197,7 +3205,12 @@ extern const double _double_constants[];
            Zero(&aldouble, 1, long double);
            while (len-- > 0) {
                fromstr = NEXTFROM;
+#  ifdef __GNUC__
+               /* to work round a gcc/x86 bug; don't use SvNV */
+               aldouble.ld = (long double)sv_2nv(fromstr);
+#  else
                aldouble.ld = (long double)SvNV(fromstr);
+#  endif
                DO_BO_PACK_N(aldouble, long double);
                PUSH_BYTES(utf8, cur, aldouble.bytes, sizeof(aldouble.bytes));
            }
@@ -3353,7 +3366,7 @@ extern const double _double_constants[];
                    goto w_string;
                else if (SvNOKp(fromstr)) {
                    /* 10**NV_MAX_10_EXP is the largest power of 10
-                      so 10**(NV_MAX_10_EXP+1) is definately unrepresentable
+                      so 10**(NV_MAX_10_EXP+1) is definitely unrepresentable
                       given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x:
                       x = (NV_MAX_10_EXP+1) * log (10) / log (128)
                       And with that many bytes only Inf can overflow.
@@ -3556,7 +3569,7 @@ extern const double _double_constants[];
            from_utf8 = DO_UTF8(fromstr);
            if (from_utf8) {
                aend = aptr + fromlen;
-               fromlen = sv_len_utf8(fromstr);
+               fromlen = sv_len_utf8_nomg(fromstr);
            } else aend = NULL; /* Unused, but keep compilers happy */
            GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2);
            while (fromlen > 0) {
@@ -3574,7 +3587,9 @@ extern const double _double_constants[];
                                      'u' | TYPE_IS_PACK)) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
-                       Perl_croak(aTHX_ "panic: string is shorter than advertised");
+                       Perl_croak(aTHX_ "panic: string is shorter than advertised, "
+                                  "aptr=%p, aend=%p, buffer=%p, todo=%ld",
+                                  aptr, aend, buffer, (long) todo);
                    }
                    end = doencodes(hunk, buffer, todo);
                } else {
@@ -3600,11 +3615,11 @@ extern const double _double_constants[];
 PP(pp_pack)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    register SV *cat = TARG;
+    SV *cat = TARG;
     STRLEN fromlen;
     SV *pat_sv = *++MARK;
-    register const char *pat = SvPV_const(pat_sv, fromlen);
-    register const char *patend = pat + fromlen;
+    const char *pat = SvPV_const(pat_sv, fromlen);
+    const char *patend = pat + fromlen;
 
     MARK++;
     sv_setpvs(cat, "");
@@ -3622,8 +3637,8 @@ PP(pp_pack)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */