diff options
Diffstat (limited to 'pp_pack.c')
| -rw-r--r-- | pp_pack.c | 35 |
1 files changed, 34 insertions, 1 deletions
@@ -177,6 +177,8 @@ S_mul128(pTHX_ SV *sv, U8 m) char *s = SvPV(sv, len); char *t; + PERL_ARGS_ASSERT_MUL128; + if (!strnEQ(s, "0000", 4)) { /* need to grow sv */ SV * const tmpNew = newSVpvs("0000000000"); @@ -705,6 +707,8 @@ STATIC char * S_bytes_to_uni(const U8 *start, STRLEN len, char *dest) { const U8 * const end = start + len; + PERL_ARGS_ASSERT_BYTES_TO_UNI; + while (start < end) { const UV uv = NATIVE_TO_ASCII(*start); if (UNI_IS_INVARIANT(uv)) @@ -784,6 +788,8 @@ S_measure_struct(pTHX_ tempsym_t* symptr) { I32 total = 0; + PERL_ARGS_ASSERT_MEASURE_STRUCT; + while (next_symbol(symptr)) { I32 len; int size; @@ -893,6 +899,8 @@ S_measure_struct(pTHX_ tempsym_t* symptr) STATIC const char * S_group_end(pTHX_ register const char *patptr, register const char *patend, char ender) { + PERL_ARGS_ASSERT_GROUP_END; + while (patptr < patend) { const char c = *patptr++; @@ -923,6 +931,9 @@ STATIC const char * S_get_num(pTHX_ register const char *patptr, I32 *lenptr ) { I32 len = *patptr++ - '0'; + + PERL_ARGS_ASSERT_GET_NUM; + while (isDIGIT(*patptr)) { if (len >= 0x7FFFFFFF/10) Perl_croak(aTHX_ "pack/unpack repeat count overflow"); @@ -941,6 +952,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) const char* patptr = symptr->patptr; const char* const patend = symptr->patend; + PERL_ARGS_ASSERT_NEXT_SYMBOL; + symptr->flags &= ~FLAG_SLASH; while (patptr < patend) { @@ -1120,6 +1133,9 @@ STATIC bool need_utf8(const char *pat, const char *patend) { bool first = TRUE; + + PERL_ARGS_ASSERT_NEED_UTF8; + while (pat < patend) { if (pat[0] == '#') { pat++; @@ -1135,6 +1151,8 @@ need_utf8(const char *pat, const char *patend) STATIC char first_symbol(const char *pat, const char *patend) { + PERL_ARGS_ASSERT_FIRST_SYMBOL; + while (pat < patend) { if (pat[0] != '#') return pat[0]; pat++; @@ -1159,6 +1177,8 @@ Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, cons { tempsym_t sym; + PERL_ARGS_ASSERT_UNPACKSTRING; + if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8; else if (need_utf8(pat, patend)) { /* We probably should try to avoid this in case a scalar context call @@ -1185,7 +1205,6 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c SV *sv; const I32 start_sp_offset = SP - PL_stack_base; howlen_t howlen; - I32 checksum = 0; UV cuv = 0; NV cdouble = 0.0; @@ -1194,6 +1213,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c bool explicit_length; const bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0; bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0; + + PERL_ARGS_ASSERT_UNPACK_REC; + symptr->strbeg = s - strbeg; while (next_symbol(symptr)) { @@ -2279,6 +2301,8 @@ S_is_an_int(pTHX_ const char *s, STRLEN l) bool skip = 1; bool ignore = 0; + PERL_ARGS_ASSERT_IS_AN_INT; + while (*s) { switch (*s) { case ' ': @@ -2327,6 +2351,8 @@ S_div128(pTHX_ SV *pnum, bool *done) char *t = s; int m = 0; + PERL_ARGS_ASSERT_DIV128; + *done = 1; while (*t) { const int i = m * 10 + (*t - '0'); @@ -2356,6 +2382,8 @@ Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV ** dVAR; tempsym_t sym; + PERL_ARGS_ASSERT_PACKLIST; + TEMPSYM_INIT(&sym, pat, patend, FLAG_PACK); /* We're going to do changes through SvPVX(cat). Make sure it's valid. @@ -2440,6 +2468,9 @@ S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) { const STRLEN cur = SvCUR(sv); const STRLEN len = SvLEN(sv); STRLEN extend; + + PERL_ARGS_ASSERT_SV_EXP_GROW; + if (len - cur > needed) return SvPVX(sv); extend = needed > len ? needed : len; return SvGROW(sv, len+extend+1); @@ -2456,6 +2487,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0; bool warn_utf8 = ckWARN(WARN_UTF8); + PERL_ARGS_ASSERT_PACK_REC; + if (symptr->level == 0 && found && symptr->code == 'U') { marked_upgrade(aTHX_ cat, symptr); symptr->flags |= FLAG_DO_UTF8; |