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) &&
STRLEN n_a;
tmps = POPpx;
- XPUSHu(scan_hex(tmps, 99, &argtype));
+ XPUSHn(scan_hex(tmps, 99, &argtype));
RETURN;
}
PP(pp_oct)
{
djSP; dTARGET;
- UV value;
+ NV value;
I32 argtype;
char *tmps;
STRLEN n_a;
value = scan_bin(++tmps, 99, &argtype);
else
value = scan_oct(tmps, 99, &argtype);
- XPUSHu(value);
+ XPUSHn(value);
RETURN;
}
s = (U8*)SvPV_force(sv, slen);
Copy(tmpbuf, s, ulen, U8);
}
- } else {
+ }
+ else {
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
s = (U8*)SvPV_force(sv, slen);
Copy(tmpbuf, s, ulen, U8);
}
- } else {
+ }
+ else {
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
if (!len) {
sv_setpvn(TARG, "", 0);
SETs(TARG);
- } else {
+ }
+ else {
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
(void)SvPOK_only(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
SETs(TARG);
}
- } else {
+ }
+ else {
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
if (!len) {
sv_setpvn(TARG, "", 0);
SETs(TARG);
- } else {
+ }
+ else {
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
(void)SvPOK_only(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
SETs(TARG);
}
- } else {
+ }
+ else {
if (!SvPADTMP(sv)) {
dTARGET;
sv_setsv(TARG, sv);
PP(pp_each)
{
- djSP; dTARGET;
+ djSP;
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
if (entry) {
PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (gimme == G_ARRAY) {
+ SV *val;
PUTBACK;
/* might clobber stack_sp */
- sv_setsv(TARG, realhv ?
- hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
+ val = realhv ?
+ hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
SPAGAIN;
- PUSHs(TARG);
+ PUSHs(val);
}
}
else if (gimme == G_SCALAR)
s += UTF8SKIP(s);
down = (char*)(s - 1);
if (s > send || !((*down & 0xc0) == 0x80)) {
- Perl_warn(aTHX_ "Malformed UTF-8 character");
+ if (ckWARN_d(WARN_UTF8))
+ Perl_warner(aTHX_ WARN_UTF8,
+ "Malformed UTF-8 character");
break;
}
while (down > up) {
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':
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;
}
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");
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
(unsigned long)thr, (unsigned long)sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- save_destructor(Perl_unlock_condpair, sv);
+ SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
}
#endif /* USE_THREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV