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;
}
}
else if (isDIGIT(*pat)) {
len = *pat++ - '0';
- while (isDIGIT(*pat))
+ while (isDIGIT(*pat)) {
len = (len * 10) + (*pat++ - '0');
+ if (len < 0)
+ Perl_croak(aTHX_ "Repeat count in unpack overflows");
+ }
}
else
len = (datumtype != '@');
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 if (isDIGIT(*pat)) {
len = *pat++ - '0';
- while (isDIGIT(*pat))
+ while (isDIGIT(*pat)) {
len = (len * 10) + (*pat++ - '0');
+ if (len < 0)
+ Perl_croak(aTHX_ "Repeat count in pack overflows");
+ }
}
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");
++s;
}
}
- else if (strEQ("^", rx->precomp)) {
+ else if (rx->prelen == 1 && *rx->precomp == '^') {
+ if (!(pm->op_pmflags & PMf_MULTILINE)
+ && !(pm->op_pmregexp->reganch & ROPT_WARNED)) {
+ if (ckWARN(WARN_DEPRECATED))
+ Perl_warner(aTHX_ WARN_DEPRECATED,
+ "split /^/ better written as split /^/m");
+ pm->op_pmregexp->reganch |= ROPT_WARNED;
+ }
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != '\n'; m++) ;