&& block_gimme() == G_VOID ))
&& (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))
)
- SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
+ SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : &PL_sv_no);
else if (gimme == G_SCALAR) {
SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
SETs(sv);
if (strnEQ(s, "CORE::", 6)) {
const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
if (!code)
- DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"",
+ DIE(aTHX_ "Can't find an opnumber for \"%" UTF8f "\"",
UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6));
{
SV * const sv = core_prototype(NULL, s + 6, code, NULL);
sv = NULL;
if (elem) {
/* elem will always be NUL terminated. */
- const char * const second_letter = elem + 1;
switch (*elem) {
case 'A':
- if (len == 5 && strEQ(second_letter, "RRAY"))
+ if (memEQs(elem, len, "ARRAY"))
{
tmpRef = MUTABLE_SV(GvAV(gv));
if (tmpRef && !AvREAL((const AV *)tmpRef)
}
break;
case 'C':
- if (len == 4 && strEQ(second_letter, "ODE"))
+ if (memEQs(elem, len, "CODE"))
tmpRef = MUTABLE_SV(GvCVu(gv));
break;
case 'F':
- if (len == 10 && strEQ(second_letter, "ILEHANDLE")) {
+ if (memEQs(elem, len, "FILEHANDLE")) {
tmpRef = MUTABLE_SV(GvIOp(gv));
}
else
- if (len == 6 && strEQ(second_letter, "ORMAT"))
+ if (memEQs(elem, len, "FORMAT"))
tmpRef = MUTABLE_SV(GvFORM(gv));
break;
case 'G':
- if (len == 4 && strEQ(second_letter, "LOB"))
+ if (memEQs(elem, len, "GLOB"))
tmpRef = MUTABLE_SV(gv);
break;
case 'H':
- if (len == 4 && strEQ(second_letter, "ASH"))
+ if (memEQs(elem, len, "HASH"))
tmpRef = MUTABLE_SV(GvHV(gv));
break;
case 'I':
- if (*second_letter == 'O' && !elem[2] && len == 2)
+ if (memEQs(elem, len, "IO"))
tmpRef = MUTABLE_SV(GvIOp(gv));
break;
case 'N':
- if (len == 4 && strEQ(second_letter, "AME"))
+ if (memEQs(elem, len, "NAME"))
sv = newSVhek(GvNAME_HEK(gv));
break;
case 'P':
- if (len == 7 && strEQ(second_letter, "ACKAGE")) {
+ if (memEQs(elem, len, "PACKAGE")) {
const HV * const stash = GvSTASH(gv);
const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
}
break;
case 'S':
- if (len == 6 && strEQ(second_letter, "CALAR"))
+ if (memEQs(elem, len, "SCALAR"))
tmpRef = GvSVn(gv);
break;
}
}
}
else
- sv_setpvs(retval, "");
+ SvPVCLEAR(retval);
}
else if (s && len) {
s += --len;
SvNIOK_off(sv);
}
else
- sv_setpvs(retval, "");
+ SvPVCLEAR(retval);
SvSETMAGIC(sv);
}
return count;
case SVt_PVCV:
if (cv_const_sv((const CV *)sv))
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
- "Constant subroutine %"SVf" undefined",
+ "Constant subroutine %" SVf " undefined",
SVfARG(CvANON((const CV *)sv)
? newSVpvs_flags("(anonymous)", SVs_TEMP)
: sv_2mortal(newSVhek(
{
SV * const arg = TOPs;
const NV value = SvNV_nomg(arg);
+#ifdef NV_NAN
NV result = NV_NAN;
+#else
+ NV result = 0.0;
+#endif
if (neg_report) { /* log or sqrt */
if (
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
(op_type == OP_LOG ? (value <= 0.0) : (value < 0.0))) {
SET_NUMERIC_STANDARD();
/* diag_listed_as: Can't take log of %g */
- DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
+ DIE(aTHX_ "Can't take %s of %" NVgf, neg_report, value);
}
}
switch (op_type) {
}
} else {
if (!SvPADTMP(TARG)) {
- sv_setsv_nomg(TARG, &PL_sv_undef);
+ sv_set_undef(TARG);
} else { /* TARG is on stack at this point and is overwriten by SETs.
This branch is the odd one out, so put TARG by default on
stack earlier to let local SP go out of liveness sooner */
repl = SvPV_const(repl_sv_copy, repl_len);
}
if (!SvOK(sv))
- sv_setpvs(sv, "");
+ SvPVCLEAR(sv);
sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
SvREFCNT_dec(repl_sv_copy);
}
if (UNLIKELY(SvAMAGIC(top)))
top = sv_2num(top);
if (UNLIKELY(isinfnansv(top)))
- Perl_croak(aTHX_ "Cannot chr %"NVgf, SvNV(top));
+ Perl_croak(aTHX_ "Cannot chr %" NVgf, SvNV(top));
else {
if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
&& ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
top = top2;
}
Perl_warner(aTHX_ packWARN(WARN_UTF8),
- "Invalid negative number (%"SVf") in chr", SVfARG(top));
+ "Invalid negative number (%" SVf ") in chr", SVfARG(top));
}
value = UNICODE_REPLACEMENT;
} else {
ulen = UTF8SKIP(s);
if (op_type == OP_UCFIRST) {
#ifdef USE_LOCALE_CTYPE
- _to_utf8_title_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+ _toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
#else
- _to_utf8_title_flags(s, tmpbuf, &tculen, 0);
+ _toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, 0);
#endif
}
else {
#ifdef USE_LOCALE_CTYPE
- _to_utf8_lower_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+ _toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
#else
- _to_utf8_lower_flags(s, tmpbuf, &tculen, 0);
+ _toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, 0);
#endif
}
u = UTF8SKIP(s);
#ifdef USE_LOCALE_CTYPE
- uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+ uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
#else
- uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, 0);
+ uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, 0);
#endif
#define GREEK_CAPITAL_LETTER_IOTA 0x0399
#define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
* allocate without allocating too much. Such is life.
* See corresponding comment in lc code for another option
* */
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
d += ulen;
* ASCII. If not enough room, grow the string */
if (SvLEN(dest) < ++min) {
const UV o = d - (U8*)SvPVX_const(dest);
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
*d++ = 'S'; *d = 'S'; /* upper case is 'SS' */
continue; /* Back to the tight loop; still in ASCII */
STRLEN ulen;
#ifdef USE_LOCALE_CTYPE
- _to_utf8_lower_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+ _toLOWER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
#else
- _to_utf8_lower_flags(s, tmpbuf, &ulen, 0);
+ _toLOWER_utf8_flags(s, send, tmpbuf, &ulen, 0);
#endif
/* Here is where we would do context-sensitive actions. See the
* Another option would be to grow an extra byte or two more
* each time we need to grow, which would cut down the million
* to 500K, with little waste */
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
/* Copy the newly lowercased letter to the output buffer we're
to_quote = TRUE;
}
}
- else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
+ else if (UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, s + len)) {
if (
#ifdef USE_LOCALE_CTYPE
/* In locale, we quote all non-ASCII Latin1 chars.
const STRLEN u = UTF8SKIP(s);
STRLEN ulen;
- _to_utf8_fold_flags(s, tmpbuf, &ulen, flags);
+ _toFOLD_utf8_flags(s, send, tmpbuf, &ulen, flags);
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
const UV o = d - (U8*)SvPVX_const(dest);
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
* becomes "ss", which may require growing the SV. */
if (SvLEN(dest) < ++min) {
const UV o = d - (U8*)SvPVX_const(dest);
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
*(d)++ = 's';
*d = 's';
for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
SvREFCNT_dec(*dst++); /* free them now */
}
+ if (!*MARK)
+ *MARK = &PL_sv_undef;
}
AvFILLp(ary) += diff;
while (length-- > 0)
SvREFCNT_dec(tmparyval[length]);
}
+ if (!*MARK)
+ *MARK = &PL_sv_undef;
}
else
*MARK = &PL_sv_undef;
PP(pp_split)
{
dSP; dTARG;
- AV *ary = PL_op->op_flags & OPf_STACKED ? (AV *)POPs : NULL;
+ AV *ary = ( (PL_op->op_private & OPpSPLIT_ASSIGN) /* @a = split */
+ && (PL_op->op_flags & OPf_STACKED)) /* @{expr} = split */
+ ? (AV *)POPs : NULL;
IV limit = POPi; /* note, negative is forever */
SV * const sv = POPs;
STRLEN len;
const char *s = SvPV_const(sv, len);
const bool do_utf8 = DO_UTF8(sv);
const char *strend = s + len;
- PMOP *pm;
+ PMOP *pm = cPMOPx(PL_op);
REGEXP *rx;
SV *dstr;
const char *m;
I32 base;
const U8 gimme = GIMME_V;
bool gimme_scalar;
- const I32 oldsave = PL_savestack_ix;
+ I32 oldsave = PL_savestack_ix;
U32 make_mortal = SVs_TEMP;
bool multiline = 0;
MAGIC *mg = NULL;
-#ifdef DEBUGGING
- Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
-#else
- pm = (PMOP*)POPs;
-#endif
- if (!pm)
- DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s);
rx = PM_GETRE(pm);
TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
(RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
+ /* handle @ary = split(...) optimisation */
+ if (PL_op->op_private & OPpSPLIT_ASSIGN) {
+ if (!(PL_op->op_flags & OPf_STACKED)) {
+ if (PL_op->op_private & OPpSPLIT_LEX) {
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+ ary = (AV *)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff);
+ }
+ else {
+ GV *gv =
#ifdef USE_ITHREADS
- if (pm->op_pmreplrootu.op_pmtargetoff) {
- ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)));
- goto have_av;
- }
+ MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
#else
- if (pm->op_pmreplrootu.op_pmtargetgv) {
- ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
- goto have_av;
- }
+ pm->op_pmreplrootu.op_pmtargetgv;
#endif
- else if (pm->op_targ)
- ary = (AV *)PAD_SVl(pm->op_targ);
- if (ary) {
- have_av:
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ ary = save_ary(gv);
+ else
+ ary = GvAVn(gv);
+ }
+ /* skip anything pushed by OPpLVAL_INTRO above */
+ oldsave = PL_savestack_ix;
+ }
+
realarray = 1;
PUTBACK;
av_extend(ary,0);
make_mortal = 0;
}
}
+
base = SP - PL_stack_base;
orig = s;
if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
if (do_utf8) {
- while (isSPACE_utf8(s))
+ while (s < strend && isSPACE_utf8_safe(s, strend))
s += UTF8SKIP(s);
}
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
- while (isSPACE_LC(*s))
+ while (s < strend && isSPACE_LC(*s))
s++;
}
else {
- while (isSPACE(*s))
+ while (s < strend && isSPACE(*s))
s++;
}
}
m = s;
/* this one uses 'm' and is a negative test */
if (do_utf8) {
- while (m < strend && ! isSPACE_utf8(m) ) {
+ while (m < strend && ! isSPACE_utf8_safe(m, strend) ) {
const int t = UTF8SKIP(m);
- /* isSPACE_utf8 returns FALSE for malform utf8 */
+ /* isSPACE_utf8_safe returns FALSE for malform utf8 */
if (strend - m < t)
m = strend;
else
/* this one uses 's' and is a positive test */
if (do_utf8) {
- while (s < strend && isSPACE_utf8(s) )
+ while (s < strend && isSPACE_utf8_safe(s, strend) )
s += UTF8SKIP(s);
}
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
if (TOPs && !make_mortal)
sv_2mortal(TOPs);
- *SP-- = &PL_sv_undef;
+ *SP-- = NULL;
iters--;
}
}
}
GETTARGET;
- PUSHi(iters);
+ XPUSHi(iters);
RETURN;
}
dVAR; dSP;
return PL_ppaddr[
(SvTYPE(TOPs) == SVt_PVAV ? OP_AEACH : OP_EACH)
- + (PL_op->op_private & 3)
+ + (PL_op->op_private & OPpAVHVSWITCH_MASK)
](aTHX);
}
https://perl5.git.perl.org / perl5.git / blobdiff