X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_pack.c;h=92d0a36a55a627da4f934d697c9e1bf40b6a2127;hb=c067b4bea65bd7b97b0ae4f7b058dd94b44a4c48;hp=b3c2f07018e9619f70fbd251b0c6f4978dc95a55;hpb=e62f0680cdecd36f79df8a7dabc61c6a2739f07a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_pack.c b/pp_pack.c index b3c2f07..92d0a36 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -240,6 +240,8 @@ S_mul128(pTHX_ SV *sv, U8 m) # define DO_BO_PACK_N(var, type) # define DO_BO_UNPACK_P(var) # define DO_BO_PACK_P(var) +# define DO_BO_UNPACK_PC(var) +# define DO_BO_PACK_PC(var) #else /* PERL_PACK_CAN_BYTEORDER */ @@ -323,6 +325,8 @@ S_mul128(pTHX_ SV *sv, U8 m) # else # define DO_BO_UNPACK_P(var) BO_CANT_DOIT(unpack, pointer) # define DO_BO_PACK_P(var) BO_CANT_DOIT(pack, pointer) +# define DO_BO_UNPACK_PC(var) BO_CANT_DOIT(unpack, pointer) +# define DO_BO_PACK_PC(var) BO_CANT_DOIT(pack, pointer) # endif # if defined(my_htolen) && defined(my_letohn) && \ @@ -1024,8 +1028,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s", *patptr, _action( symptr ) ); - if (ckWARN(WARN_UNPACK)) { - if (code & modifier) + if ((code & modifier) && ckWARN(WARN_UNPACK)) { Perl_warner(aTHX_ packWARN(WARN_UNPACK), "Duplicate modifier '%c' after '%c' in %s", *patptr, (int) TYPE_NO_MODIFIERS(code), @@ -1117,7 +1120,6 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) version of the string. Users are advised to upgrade their pack string themselves if they need to do a lot of unpacks like this on it */ -/* XXX These can be const */ STATIC bool need_utf8(const char *pat, const char *patend) { @@ -1159,9 +1161,9 @@ I32 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags) { tempsym_t sym; - (void)strbeg; - (void)new_s; - (void)ocnt; + PERL_UNUSED_ARG(strbeg); + PERL_UNUSED_ARG(new_s); + PERL_UNUSED_ARG(ocnt); if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8; else if (need_utf8(pat, patend)) { @@ -1492,7 +1494,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c if (checksum) { if (!PL_bitcount) { int bits; - Newz(601, PL_bitcount, 256, char); + Newxz(PL_bitcount, 256, char); for (bits = 1; bits < 256; bits++) { if (bits & 1) PL_bitcount[bits]++; if (bits & 2) PL_bitcount[bits]++; @@ -2005,8 +2007,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c continue; } if (++bytes >= sizeof(UV)) { /* promote to string */ - char *t; - STRLEN n_a; + const char *t; sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (int)TYPE_DIGITS(UV), auv); while (s < strend) { @@ -2017,7 +2018,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c break; } } - t = SvPV(sv, n_a); + t = SvPV_nolen_const(sv); while (*t == '0') t++; sv_chop(sv, t); @@ -2318,12 +2319,11 @@ doencodes(U8 *h, const char *s, I32 len) STATIC SV * S_is_an_int(pTHX_ const char *s, STRLEN l) { - STRLEN n_a; - SV *result = newSVpvn(s, l); - char *result_c = SvPV(result, n_a); /* convenience */ - char *out = result_c; - bool skip = 1; - bool ignore = 0; + SV *result = newSVpvn(s, l); + char *const result_c = SvPV_nolen(result); /* convenience */ + char *out = result_c; + bool skip = 1; + bool ignore = 0; while (*s) { switch (*s) { @@ -2368,25 +2368,24 @@ S_is_an_int(pTHX_ const char *s, STRLEN l) STATIC int S_div128(pTHX_ SV *pnum, bool *done) { - STRLEN len; - char *s = SvPV(pnum, len); - int m = 0; - int r = 0; - char *t = s; - - *done = 1; - while (*t) { - const int i = m * 10 + (*t - '0'); - m = i & 0x7F; - r = (i >> 7); /* r < 10 */ - if (r) { - *done = 0; + STRLEN len; + char * const s = SvPV(pnum, len); + char *t = s; + int m = 0; + + *done = 1; + while (*t) { + const int i = m * 10 + (*t - '0'); + const int r = (i >> 7); /* r < 10 */ + m = i & 0x7F; + if (r) { + *done = 0; + } + *(t++) = '0' + r; } - *(t++) = '0' + r; - } - *(t++) = '\0'; - SvCUR_set(pnum, (STRLEN) (t - s)); - return (m); + *(t++) = '\0'; + SvCUR_set(pnum, (STRLEN) (t - s)); + return (m); } /* @@ -2395,15 +2394,15 @@ S_div128(pTHX_ SV *pnum, bool *done) The engine implementing pack() Perl function. Note: parameters next_in_list and flags are not used. This call should not be used; use packlist instead. -=cut */ - +=cut +*/ void Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags) { tempsym_t sym; - (void)next_in_list; - (void)flags; + PERL_UNUSED_ARG(next_in_list); + PERL_UNUSED_ARG(flags); TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK); @@ -2416,8 +2415,8 @@ Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV ** The engine implementing pack() Perl function. -=cut */ - +=cut +*/ void Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist ) @@ -2430,7 +2429,8 @@ Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV ** /* We're going to do changes through SvPVX(cat). Make sure it's valid. Also make sure any UTF8 flag is loaded */ SvPV_force(cat, no_len); - if (DO_UTF8(cat)) sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8; + if (DO_UTF8(cat)) + sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8; (void)pack_rec( cat, &sym, beglist, endlist ); } @@ -2456,11 +2456,11 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) { } len = (from_end-from_ptr)*UTF8_EXPAND+(from_ptr-from_start)+1; - New('U', to_start, len, char); + Newx(to_start, len, char); Copy(from_start, to_start, from_ptr-from_start, char); to_ptr = to_start + (from_ptr-from_start); - New('U', marks, sym_ptr->level+2, const char *); + Newx(marks, sym_ptr->level+2, const char *); for (group=sym_ptr; group; group = group->previous) marks[group->level] = from_start + group->strbeg; marks[sym_ptr->level+1] = from_end+1; @@ -2521,6 +2521,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) I32 items = endlist - beglist; bool found = next_symbol(symptr); bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0; + bool warn_utf8 = ckWARN(WARN_UTF8); if (symptr->level == 0 && found && symptr->code == 'U') { marked_upgrade(aTHX_ cat, symptr); @@ -2835,18 +2836,18 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) } case 'B': case 'b': { - char *str, *end; + const char *str, *end; I32 l, field_len; U8 bits; bool utf8_source; U32 utf8_flags; fromstr = NEXTFROM; - str = SvPV(fromstr, fromlen); + str = SvPV_const(fromstr, fromlen); end = str + fromlen; if (DO_UTF8(fromstr)) { utf8_source = TRUE; - utf8_flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; + utf8_flags = warn_utf8 ? 0 : UTF8_ALLOW_ANY; } else { utf8_source = FALSE; utf8_flags = 0; /* Unused, but keep compilers happy */ @@ -2904,18 +2905,18 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) } case 'H': case 'h': { - char *str, *end; + const char *str, *end; I32 l, field_len; U8 bits; bool utf8_source; U32 utf8_flags; fromstr = NEXTFROM; - str = SvPV(fromstr, fromlen); + str = SvPV_const(fromstr, fromlen); end = str + fromlen; if (DO_UTF8(fromstr)) { utf8_source = TRUE; - utf8_flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; + utf8_flags = warn_utf8 ? 0 : UTF8_ALLOW_ANY; } else { utf8_source = FALSE; utf8_flags = 0; /* Unused, but keep compilers happy */ @@ -3028,7 +3029,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) } cur = (char *) uvuni_to_utf8_flags((U8 *) cur, NATIVE_TO_UNI(auv), - ckWARN(WARN_UTF8) ? + warn_utf8 ? 0 : UNICODE_ALLOW_ANY); } else { if (auv >= 0x100) { @@ -3082,7 +3083,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) if (utf8) { U8 buffer[UTF8_MAXLEN], *endb; endb = uvuni_to_utf8_flags(buffer, auv, - ckWARN(WARN_UTF8) ? + warn_utf8 ? 0 : UNICODE_ALLOW_ANY); if (cur+(endb-buffer)*UTF8_EXPAND >= end) { *cur = '\0'; @@ -3100,7 +3101,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) end = start+SvLEN(cat)-UTF8_MAXLEN; } cur = (char *) uvuni_to_utf8_flags((U8 *) cur, auv, - ckWARN(WARN_UTF8) ? + warn_utf8 ? 0 : UNICODE_ALLOW_ANY); } } @@ -3371,9 +3372,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) #endif char *in = buf + sizeof(buf); - anv = Perl_floor(anv); + anv = Perl_floor(anv); do { - NV next = Perl_floor(anv / 128); + const NV next = Perl_floor(anv / 128); if (in <= buf) /* this cannot happen ;-) */ Perl_croak(aTHX_ "Cannot compress integer in pack"); *--in = (unsigned char)(anv - (next * 128)) | 0x80; @@ -3383,18 +3384,19 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) PUSH_GROWING_BYTES(utf8, cat, start, cur, in, (buf + sizeof(buf)) - in); } else { - char *from, *result, *in; + const char *from; + char *result, *in; SV *norm; STRLEN len; bool done; w_string: /* Copy string and check for compliance */ - from = SvPV(fromstr, len); + from = SvPV_const(fromstr, len); if ((norm = is_an_int(from, len)) == NULL) Perl_croak(aTHX_ "Can only compress unsigned integers in pack"); - New('w', result, len, char); + Newx(result, len, char); in = result + len; done = FALSE; while (!done) *--in = div128(norm, &done) | 0x80; @@ -3514,28 +3516,26 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) /* Fall through! */ case 'p': while (len-- > 0) { - char *aptr; + const char *aptr; fromstr = NEXTFROM; SvGETMAGIC(fromstr); if (!SvOK(fromstr)) aptr = NULL; else { - STRLEN n_a; /* XXX better yet, could spirit away the string to * a safe spot and hang on to it until the result * of pack() (and all copies of the result) are * gone. */ - if (ckWARN(WARN_PACK) && - (SvTEMP(fromstr) || (SvPADTMP(fromstr) && - !SvREADONLY(fromstr)))) { + if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) && + !SvREADONLY(fromstr))) && ckWARN(WARN_PACK)) { Perl_warner(aTHX_ packWARN(WARN_PACK), "Attempt to pack pointer to temporary value"); } if (SvPOK(fromstr) || SvNIOK(fromstr)) - aptr = SvPV_flags(fromstr, n_a, 0); + aptr = SvPV_nomg_const_nolen(fromstr); else - aptr = SvPV_force_flags(fromstr, n_a, 0); + aptr = SvPV_force_flags_nolen(fromstr, 0); } DO_BO_PACK_PC(aptr); PUSH_VAR(utf8, cur, aptr); @@ -3553,7 +3553,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) "Field too wide in 'u' format in pack"); len = 63; } - aptr = SvPV(fromstr, fromlen); + aptr = SvPV_const(fromstr, fromlen); from_utf8 = DO_UTF8(fromstr); if (from_utf8) { aend = aptr + fromlen; @@ -3603,7 +3603,8 @@ PP(pp_pack) dSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; STRLEN fromlen; - register const char *pat = SvPVx_const(*++MARK, fromlen); + SV *pat_sv = *++MARK; + register const char *pat = SvPV_const(pat_sv, fromlen); register const char *patend = pat + fromlen; MARK++;