diff options
author | Ian Phillipps <Ian.Phillipps@iname.com> | 1999-07-24 00:35:56 +0100 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1999-07-26 09:28:48 +0000 |
commit | 43192e07925c626b8d615aff545160df8bd7c3f8 (patch) | |
tree | 6fc8ce7fb7b43e513591e91fb5a635c864059f62 /pp.c | |
parent | 1f763251de9d15bd843d41adf21f5de7aa72b2ea (diff) | |
download | perl-43192e07925c626b8d615aff545160df8bd7c3f8.tar.gz |
(Version 2) Extending unpack to deal with counted strings
Message-ID: <19990723233556.B2435@homer.diplex.co.uk>
p4raw-id: //depot/perl@3765
Diffstat (limited to 'pp.c')
-rw-r--r-- | pp.c | 27 |
1 files changed, 24 insertions, 3 deletions
@@ -900,7 +900,7 @@ PP(pp_postinc) PP(pp_postdec) { djSP; dTARGET; - if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) Perl_croak(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -3386,6 +3386,18 @@ PP(pp_unpack) DIE(aTHX_ "x outside of string"); s += len; break; + case '#': + if (oldsp >= SP) + DIE(aTHX_ "# must follow a numeric type"); + if (*pat != 'a' && *pat != 'A' && *pat != 'Z') + DIE(aTHX_ "# must be followed by a, A or Z"); + datumtype = *pat++; + if (*pat == '*') + pat++; /* ignore '*' for compatibility with pack */ + if (isDIGIT(*pat)) + DIE(aTHX_ "# cannot take a count" ); + len = POPi; + /* drop through */ case 'A': case 'Z': case 'a': @@ -4356,7 +4368,8 @@ PP(pp_pack) MARK++; sv_setpvn(cat, "", 0); while (pat < patend) { -#define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no) + SV *lengthcode = Nullsv; +#define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no) datumtype = *pat++ & 0xFF; #ifdef PERL_NATINT_PACK natint = 0; @@ -4386,12 +4399,20 @@ PP(pp_pack) } else len = 1; + if (*pat == '#') { + ++pat; + if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*') + DIE(aTHX_ "# must be followed by a*, A* or Z*"); + lengthcode = sv_2mortal(newSViv(sv_len(items > 0 + ? *MARK : &PL_sv_no))); + } switch(datumtype) { default: Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype); case ',': /* grandfather in commas but with a warning */ if (commas++ == 0 && ckWARN(WARN_UNSAFE)) - Perl_warner(aTHX_ WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype); + Perl_warner(aTHX_ WARN_UNSAFE, + "Invalid type in pack: '%c'", (int)datumtype); break; case '%': DIE(aTHX_ "%% may only be used in unpack"); |