/* HEs use this offset for their arena. */
{ 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 },
- /* The bind placeholder pretends to be an RV for now.
- Also it's marked as "can't upgrade" to stop anyone using it before it's
- implemented. */
- { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
-
/* IVs are in the head, so the allocation size is 0. */
{ 0,
sizeof(IV), /* This is used to copy out the IV body. */
SVt_PV, FALSE, NONV, HASARENA,
FIT_ARENA(0, sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur)) },
+ { sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur),
+ copy_length(XINVLIST, is_offset) - STRUCT_OFFSET(XPV, xpv_cur),
+ + STRUCT_OFFSET(XPV, xpv_cur),
+ SVt_INVLIST, TRUE, NONV, HASARENA,
+ FIT_ARENA(0, sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur)) },
+
{ sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur),
copy_length(XPVIV, xiv_u) - STRUCT_OFFSET(XPV, xpv_cur),
+ STRUCT_OFFSET(XPV, xpv_cur),
{ sizeof(regexp),
sizeof(regexp),
0,
- SVt_REGEXP, FALSE, NONV, HASARENA,
+ SVt_REGEXP, TRUE, NONV, HASARENA,
FIT_ARENA(0, sizeof(regexp))
},
assert(!SvPAD_TYPED(sv));
break;
default:
- if (old_type_details->cant_upgrade)
+ if (UNLIKELY(old_type_details->cant_upgrade))
Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
}
- if (old_type > new_type)
+ if (UNLIKELY(old_type > new_type))
Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
(int)old_type, (int)new_type);
#ifndef NODEFAULT_SHAREKEYS
HvSHAREKEYS_on(sv); /* key-sharing on by default */
#endif
- HvMAX(sv) = 7; /* (start with 8 buckets) */
+ /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
+ HvMAX(sv) = PERL_HASH_DEFAULT_HvMAX;
}
/* SVt_NULL isn't the only thing upgraded to AV or HV.
case SVt_PVGV:
case SVt_PVCV:
case SVt_PVLV:
+ case SVt_INVLIST:
case SVt_REGEXP:
case SVt_PVMG:
case SVt_PVNV:
SvNV_set(sv, 0);
#endif
- if (new_type == SVt_PVIO) {
+ if (UNLIKELY(new_type == SVt_PVIO)) {
IO * const io = MUTABLE_IO(sv);
GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
IoPAGE_LEN(sv) = 60;
}
- if (new_type == SVt_REGEXP)
+ if (UNLIKELY(new_type == SVt_REGEXP))
sv->sv_u.svu_rx = (regexp *)new_body;
else if (old_type < SVt_PV) {
/* referant will be NULL unless the old type was SVt_IV emulating
=cut
*/
+static void S_sv_uncow(pTHX_ SV * const sv, const U32 flags);
+
char *
Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen)
{
PERL_ARGS_ASSERT_SV_GROW;
- if (PL_madskills && newlen >= 0x100000) {
- PerlIO_printf(Perl_debug_log,
- "Allocation too large: %"UVxf"\n", (UV)newlen);
- }
#ifdef HAS_64K_LIMIT
if (newlen >= 0x10000) {
PerlIO_printf(Perl_debug_log,
}
else
{
- if (SvIsCOW(sv)) sv_force_normal(sv);
+ if (SvIsCOW(sv)) S_sv_uncow(aTHX_ sv, 0);
s = SvPVX_mutable(sv);
}
+#ifdef PERL_NEW_COPY_ON_WRITE
+ /* the new COW scheme uses SvPVX(sv)[SvLEN(sv)-1] (if spare)
+ * to store the COW count. So in general, allocate one more byte than
+ * asked for, to make it likely this byte is always spare: and thus
+ * make more strings COW-able.
+ * If the new size is a big power of two, don't bother: we assume the
+ * caller wanted a nice 2^N sized block and will be annoyed at getting
+ * 2^N+1 */
+ if (newlen & 0xff)
+ newlen++;
+#endif
+
if (newlen > SvLEN(sv)) { /* need more room? */
STRLEN minlen = SvCUR(sv);
minlen += (minlen >> PERL_STRLEN_EXPAND_SHIFT) + 10;
SvSETMAGIC(sv);
}
-/* Print an "isn't numeric" warning, using a cleaned-up,
- * printable version of the offending string
+/* Return a cleaned-up, printable version of sv, for non-numeric, or
+ * not incrementable warning display.
+ * Originally part of S_not_a_number().
+ * The return value may be != tmpbuf.
*/
-STATIC void
-S_not_a_number(pTHX_ SV *const sv)
-{
- dVAR;
- SV *dsv;
- char tmpbuf[64];
- const char *pv;
+STATIC const char *
+S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) {
+ const char *pv;
- PERL_ARGS_ASSERT_NOT_A_NUMBER;
+ PERL_ARGS_ASSERT_SV_DISPLAY;
if (DO_UTF8(sv)) {
- dsv = newSVpvs_flags("", SVs_TEMP);
+ SV *dsv = newSVpvs_flags("", SVs_TEMP);
pv = sv_uni_display(dsv, sv, 10, UNI_DISPLAY_ISPRINT);
} else {
char *d = tmpbuf;
- const char * const limit = tmpbuf + sizeof(tmpbuf) - 8;
+ const char * const limit = tmpbuf + tmpbuf_size - 8;
/* each *s can expand to 4 chars + "...\0",
i.e. need room for 8 chars */
pv = tmpbuf;
}
+ return pv;
+}
+
+/* Print an "isn't numeric" warning, using a cleaned-up,
+ * printable version of the offending string
+ */
+
+STATIC void
+S_not_a_number(pTHX_ SV *const sv)
+{
+ dVAR;
+ char tmpbuf[64];
+ const char *pv;
+
+ PERL_ARGS_ASSERT_NOT_A_NUMBER;
+
+ pv = sv_display(sv, tmpbuf, sizeof(tmpbuf));
+
if (PL_op)
Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
/* diag_listed_as: Argument "%s" isn't numeric%s */
"Argument \"%s\" isn't numeric", pv);
}
+STATIC void
+S_not_incrementable(pTHX_ SV *const sv) {
+ dVAR;
+ char tmpbuf[64];
+ const char *pv;
+
+ PERL_ARGS_ASSERT_NOT_INCREMENTABLE;
+
+ pv = sv_display(sv, tmpbuf, sizeof(tmpbuf));
+
+ Perl_warner(aTHX_ packWARN(WARN_NUMERIC),
+ "Argument \"%s\" treated as 0 in increment (++)", pv);
+}
+
/*
=for apidoc looks_like_number
if (!sv)
return 0;
+ assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
+ && SvTYPE(sv) != SVt_PVFM);
+
if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
mg_get(sv);
dVAR;
if (!sv)
return 0.0;
+ assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
+ && SvTYPE(sv) != SVt_PVFM);
if (SvGMAGICAL(sv) || SvVALID(sv) || isREGEXP(sv)) {
/* FBMs use the space for SvIVX and SvNVX for other purposes, and use
the same flag bit as SVf_IVisUV, so must not let them cache NVs.
*lp = 0;
return (char *)"";
}
+ assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
+ && SvTYPE(sv) != SVt_PVFM);
if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
mg_get(sv);
if (SvROK(sv)) {
Move(ptr, s, len, char);
s += len;
*s = '\0';
+ SvPOK_on(sv);
}
else if (SvNOK(sv)) {
if (SvTYPE(sv) < SVt_PVNV)
/* The +20 is pure guesswork. Configure test needed. --jhi */
s = SvGROW_mutable(sv, NV_DIG + 20);
/* some Xenix systems wipe out errno here */
- Gconvert(SvNVX(sv), NV_DIG, 0, s);
+
+#ifndef USE_LOCALE_NUMERIC
+ Gconvert(SvNVX(sv), NV_DIG, 0, s);
+ SvPOK_on(sv);
+#else
+ /* Gconvert always uses the current locale. That's the right thing
+ * to do if we're supposed to be using locales. But otherwise, we
+ * want the result to be based on the C locale, so we need to
+ * change to the C locale during the Gconvert and then change back.
+ * But if we're already in the C locale (PL_numeric_standard is
+ * TRUE in that case), no need to do any changing */
+ if (PL_numeric_standard || IN_SOME_LOCALE_FORM_RUNTIME) {
+ Gconvert(SvNVX(sv), NV_DIG, 0, s);
+
+ /* If the radix character is UTF-8, and actually is in the
+ * output, turn on the UTF-8 flag for the scalar */
+ if (! PL_numeric_standard
+ && PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
+ && instr(s, SvPVX_const(PL_numeric_radix_sv)))
+ {
+ SvUTF8_on(sv);
+ }
+ }
+ else {
+ char *loc = savepv(setlocale(LC_NUMERIC, NULL));
+ setlocale(LC_NUMERIC, "C");
+ Gconvert(SvNVX(sv), NV_DIG, 0, s);
+ setlocale(LC_NUMERIC, loc);
+ Safefree(loc);
+
+ }
+
+ /* We don't call SvPOK_on(), because it may come to pass that the
+ * locale changes so that the stringification we just did is no
+ * longer correct. We will have to re-stringify every time it is
+ * needed */
+#endif
RESTORE_ERRNO;
while (*s) s++;
}
*lp = len;
SvCUR_set(sv, len);
}
- SvPOK_on(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
PTR2UV(sv),SvPVX_const(sv)));
if (flags & SV_CONST_RETURN)
{
PERL_ARGS_ASSERT_SV_2PVBYTE;
+ SvGETMAGIC(sv);
if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
|| isGV_with_GP(sv) || SvROK(sv)) {
SV *sv2 = sv_newmortal();
- sv_copypv(sv2,sv);
+ sv_copypv_nomg(sv2,sv);
sv = sv2;
}
- else SvGETMAGIC(sv);
sv_utf8_downgrade(sv,0);
return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
}
}
return SvRV(sv) != 0;
}
+ if (isREGEXP(sv))
+ return
+ RX_WRAPLEN(sv) > 1 || (RX_WRAPLEN(sv) && *RX_WRAPPED(sv) != '0');
return SvTRUE_common(sv, isGV_with_GP(sv) ? 1 : 0);
}
}
if (SvIsCOW(sv)) {
- sv_force_normal_flags(sv, 0);
+ S_sv_uncow(aTHX_ sv, 0);
}
if (PL_encoding && !(flags & SV_UTF8_NO_ENCODING)) {
int mg_flags = SV_GMAGIC;
if (SvIsCOW(sv)) {
- sv_force_normal_flags(sv, 0);
+ S_sv_uncow(aTHX_ sv, 0);
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
/* update pos */
);
}
else if(mro_changes) mro_method_changed_in(GvSTASH(dstr));
+ if (GvIO(dstr) && dtype == SVt_PVGV) {
+ DEBUG_o(Perl_deb(aTHX_
+ "glob_assign_glob clearing PL_stashcache\n"));
+ /* It's a cache. It will rebuild itself quite happily.
+ It's a lot of effort to work out exactly which key (or keys)
+ might be invalidated by the creation of the this file handle.
+ */
+ hv_clear(PL_stashcache);
+ }
return;
}
}
break;
- /* case SVt_BIND: */
+ case SVt_INVLIST:
case SVt_PVLV:
case SVt_PVGV:
case SVt_PVMG:
? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
# ifdef PERL_OLD_COPY_ON_WRITE
&& (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
- && SvTYPE(sstr) >= SVt_PVIV
+ && SvTYPE(sstr) >= SVt_PVIV && len
# else
&& !(SvFLAGS(dstr) & SVf_BREAK)
&& !(sflags & SVf_IsCOW)
{
SV_CHECK_THINKFIRST_COW_DROP(sv);
SvUPGRADE(sv, SVt_PV);
- Safefree(SvPVX(sv));
+ SvPV_free(sv);
SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
SvCUR_set(sv, HEK_LEN(hek));
SvLEN_set(sv, 0);
=cut
*/
-void
-Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
+static void
+S_sv_uncow(pTHX_ SV * const sv, const U32 flags)
{
dVAR;
- PERL_ARGS_ASSERT_SV_FORCE_NORMAL_FLAGS;
-
+ assert(SvIsCOW(sv));
+ {
#ifdef PERL_ANY_COW
- if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
- Perl_croak_no_modify();
- }
- else if (SvIsCOW(sv)) {
const char * const pvx = SvPVX_const(sv);
const STRLEN len = SvLEN(sv);
const STRLEN cur = SvCUR(sv);
sv_dump(sv);
}
}
- }
#else
- if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
- Perl_croak_no_modify();
- }
- else
- if (SvIsCOW(sv)) {
const char * const pvx = SvPVX_const(sv);
const STRLEN len = SvCUR(sv);
SvIsCOW_off(sv);
*SvEND(sv) = '\0';
}
unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
- }
#endif
+ }
+}
+
+void
+Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
+{
+ PERL_ARGS_ASSERT_SV_FORCE_NORMAL_FLAGS;
+
+ if (SvREADONLY(sv))
+ Perl_croak_no_modify();
+ else if (SvIsCOW(sv))
+ S_sv_uncow(aTHX_ sv, flags);
if (SvROK(sv))
sv_unref_flags(sv, flags);
else if (SvFAKE(sv) && isGV_with_GP(sv))
evacp = p - evacn;
#endif
+ /* This sets 'delta' to the accumulated value of all deltas so far */
delta += old_delta;
assert(delta);
+
+ /* If 'delta' fits in a byte, store it just prior to the new beginning of
+ * the string; otherwise store a 0 byte there and store 'delta' just prior
+ * to that, using as many bytes as a STRLEN occupies. Thus it overwrites a
+ * portion of the chopped part of the string */
if (delta < 0x100) {
*--p = (U8) delta;
} else {
PERL_ARGS_ASSERT_SV_MAGICEXT;
+ if (SvTYPE(sv)==SVt_PVAV) { assert (!AvPAD_NAMELIST(sv)); }
+
SvUPGRADE(sv, SVt_PVMG);
Newxz(mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
return mg;
}
+MAGIC *
+Perl_sv_magicext_mglob(pTHX_ SV *sv)
+{
+ PERL_ARGS_ASSERT_SV_MAGICEXT_MGLOB;
+ if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
+ /* This sv is only a delegate. //g magic must be attached to
+ its target. */
+ vivify_defelem(sv);
+ sv = LvTARG(sv);
+ }
+#ifdef PERL_OLD_COPY_ON_WRITE
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+#endif
+ return sv_magicext(sv, NULL, PERL_MAGIC_regex_global,
+ &PL_vtbl_mglob, 0, 0);
+}
+
/*
=for apidoc sv_magic
vtable = (vtable_index == magic_vtable_max)
? NULL : PL_magic_vtables + vtable_index;
-#ifdef PERL_ANY_COW
+#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
#endif
if (SvREADONLY(sv)) {
if (
- /* its okay to attach magic to shared strings */
- !SvIsCOW(sv)
-
- && IN_PERL_RUNTIME
- && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
+ !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
)
{
Perl_croak_no_modify();
}
else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
SvREFCNT_dec(SvOURSTASH(sv));
+ }
+ else if (type == SVt_PVAV && AvPAD_NAMELIST(sv)) {
+ assert(!SvMAGICAL(sv));
} else if (SvMAGIC(sv)) {
/* Free back-references before other types of magic. */
sv_unmagic(sv, PERL_MAGIC_backref);
SvREFCNT_dec(SvSTASH(sv));
}
switch (type) {
- /* case SVt_BIND: */
+ /* case SVt_INVLIST: */
case SVt_PVIO:
if (IoIFP(sv) &&
IoIFP(sv) != PerlIO_stdin() &&
PL_last_in_gv = NULL;
else if ((const GV *)sv == PL_statgv)
PL_statgv = NULL;
+ else if ((const GV *)sv == PL_stderrgv)
+ PL_stderrgv = NULL;
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
+ case SVt_INVLIST:
case SVt_PV:
freescalar:
/* Don't bother with SvOOK_off(sv); as we're only going to
continue;
}
#endif
- if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ if (SvIMMORTAL(sv)) {
/* make sure SvREFCNT(sv)==0 happens very seldom */
- SvREFCNT(sv) = (~(U32)0)/2;
+ SvREFCNT(sv) = SvREFCNT_IMMORTAL;
continue;
}
break;
SvOBJECT_off(sv); /* Curse the object. */
SvSTASH_set(sv,0); /* SvREFCNT_dec may try to read this */
SvREFCNT_dec(stash); /* possibly of changed persuasion */
- if (SvTYPE(sv) != SVt_PVIO)
- --PL_sv_objcount;/* XXX Might want something more general */
}
return TRUE;
}
PERL_ARGS_ASSERT_SV_FREE2;
- if (rc == 1) {
+ if (LIKELY( rc == 1 )) {
/* normal case */
SvREFCNT(sv) = 0;
return;
}
#endif
- if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ if (SvIMMORTAL(sv)) {
/* make sure SvREFCNT(sv)==0 happens very seldom */
- SvREFCNT(sv) = (~(U32)0)/2;
+ SvREFCNT(sv) = SvREFCNT_IMMORTAL;
return;
}
sv_clear(sv);
return;
if (PL_in_clean_all) /* All is fair */
return;
- if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
+ if (SvIMMORTAL(sv)) {
/* make sure SvREFCNT(sv)==0 happens very seldom */
- SvREFCNT(sv) = (~(U32)0)/2;
+ SvREFCNT(sv) = SvREFCNT_IMMORTAL;
return;
}
if (ckWARN_d(WARN_INTERNAL)) {
/*
=for apidoc sv_pos_u2b_flags
-Converts the value pointed to by offsetp from a count of UTF-8 chars from
+Converts the offset from a count of UTF-8 chars from
the start of the string, to a count of the equivalent number of bytes; if
lenp is non-zero, it does the same to lenp, but this time starting from
the offset, rather than from the start
assert(*mgp);
(*mgp)->mg_len = ulen;
- /* For now, treat "overflowed" as "still unknown". See RT #72924. */
- if (ulen != (STRLEN) (*mgp)->mg_len)
- (*mgp)->mg_len = -1;
}
/* Create and update the UTF8 magic offset cache, with the proffered utf8/
}
/*
-=for apidoc sv_pos_b2u
+=for apidoc sv_pos_b2u_flags
-Converts the value pointed to by offsetp from a count of bytes from the
-start of the string, to a count of the equivalent number of UTF-8 chars.
-Handles magic and type coercion.
+Converts the offset from a count of bytes from the start of the string, to
+a count of the equivalent number of UTF-8 chars. Handles type coercion.
+I<flags> is passed to C<SvPV_flags>, and usually should be
+C<SV_GMAGIC|SV_CONST_RETURN> to handle magic.
=cut
*/
/*
- * sv_pos_b2u() uses, like sv_pos_u2b(), the mg_ptr of the potential
- * PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8 and
- * byte offsets.
+ * sv_pos_b2u_flags() uses, like sv_pos_u2b_flags(), the mg_ptr of the
+ * potential PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8
+ * and byte offsets.
*
*/
-void
-Perl_sv_pos_b2u(pTHX_ SV *const sv, I32 *const offsetp)
+STRLEN
+Perl_sv_pos_b2u_flags(pTHX_ SV *const sv, STRLEN const offset, U32 flags)
{
const U8* s;
- const STRLEN byte = *offsetp;
STRLEN len = 0; /* Actually always set, but let's keep gcc happy. */
STRLEN blen;
MAGIC* mg = NULL;
const U8* send;
bool found = FALSE;
- PERL_ARGS_ASSERT_SV_POS_B2U;
-
- if (!sv)
- return;
+ PERL_ARGS_ASSERT_SV_POS_B2U_FLAGS;
- s = (const U8*)SvPV_const(sv, blen);
+ s = (const U8*)SvPV_flags(sv, blen, flags);
- if (blen < byte)
+ if (blen < offset)
Perl_croak(aTHX_ "panic: sv_pos_b2u: bad byte offset, blen=%"UVuf
- ", byte=%"UVuf, (UV)blen, (UV)byte);
+ ", byte=%"UVuf, (UV)blen, (UV)offset);
- send = s + byte;
+ send = s + offset;
if (!SvREADONLY(sv)
&& PL_utf8cache
{
if (mg->mg_ptr) {
STRLEN * const cache = (STRLEN *) mg->mg_ptr;
- if (cache[1] == byte) {
+ if (cache[1] == offset) {
/* An exact match. */
- *offsetp = cache[0];
- return;
+ return cache[0];
}
- if (cache[3] == byte) {
+ if (cache[3] == offset) {
/* An exact match. */
- *offsetp = cache[2];
- return;
+ return cache[2];
}
- if (cache[1] < byte) {
+ if (cache[1] < offset) {
/* We already know part of the way. */
if (mg->mg_len != -1) {
/* Actually, we know the end too. */
len = cache[0] + utf8_length(s + cache[1], send);
}
}
- else if (cache[3] < byte) {
+ else if (cache[3] < offset) {
/* We're between the two cached pairs, so we do the calculation
offset by the byte/utf-8 positions for the earlier pair,
then add the utf-8 characters from the string start to
+ cache[2];
}
- else { /* cache[3] > byte */
+ else { /* cache[3] > offset */
len = S_sv_pos_b2u_midway(aTHX_ s, send, s + cache[3],
cache[2]);
assert_uft8_cache_coherent("sv_pos_b2u", len, real_len, sv);
len = real_len;
}
- *offsetp = len;
if (PL_utf8cache) {
- if (blen == byte)
+ if (blen == offset)
utf8_mg_len_cache_update(sv, &mg, len);
else
- utf8_mg_pos_cache_update(sv, &mg, byte, len, blen);
+ utf8_mg_pos_cache_update(sv, &mg, offset, len, blen);
}
+
+ return len;
+}
+
+/*
+=for apidoc sv_pos_b2u
+
+Converts the value pointed to by offsetp from a count of bytes from the
+start of the string, to a count of the equivalent number of UTF-8 chars.
+Handles magic and type coercion.
+
+Use C<sv_pos_b2u_flags> in preference, which correctly handles strings
+longer than 2Gb.
+
+=cut
+*/
+
+/*
+ * sv_pos_b2u() uses, like sv_pos_u2b(), the mg_ptr of the potential
+ * PERL_MAGIC_utf8 of the sv to store the mapping between UTF-8 and
+ * byte offsets.
+ *
+ */
+void
+Perl_sv_pos_b2u(pTHX_ SV *const sv, I32 *const offsetp)
+{
+ PERL_ARGS_ASSERT_SV_POS_B2U;
+
+ if (!sv)
+ return;
+
+ *offsetp = (I32)sv_pos_b2u_flags(sv, (STRLEN)*offsetp,
+ SV_GMAGIC|SV_CONST_RETURN);
}
static void
dVAR;
STRLEN cur1, cur2;
const char *pv1, *pv2;
- char *tpv = NULL;
I32 cmp;
SV *svrecode = NULL;
}
SvREFCNT_dec(svrecode);
- if (tpv)
- Safefree(tpv);
return cmp;
}
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvIsCOW(sv) || isGV_with_GP(sv))
- sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
Perl_croak_no_modify();
}
if (SvROK(sv)) {
sv_unref(sv);
sv_setiv(sv, i);
}
+ else sv_force_normal_flags(sv, 0);
}
flags = SvFLAGS(sv);
if ((flags & (SVp_NOK|SVp_IOK)) == SVp_NOK) {
while (isALPHA(*d)) d++;
while (isDIGIT(*d)) d++;
if (d < SvEND(sv)) {
+ const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), NULL);
#ifdef PERL_PRESERVE_IVUV
/* Got to punt this as an integer if needs be, but we don't issue
warnings. Probably ought to make the sv_iv_please() that does
the conversion if possible, and silently. */
- const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), NULL);
if (numtype && !(numtype & IS_NUMBER_INFINITY)) {
/* Need to try really hard to see if it's an integer.
9.22337203685478e+18 is an integer.
#endif
}
#endif /* PERL_PRESERVE_IVUV */
+ if (!numtype && ckWARN(WARN_NUMERIC))
+ not_incrementable(sv);
sv_setnv(sv,Atof(SvPVX_const(sv)) + 1.0);
return;
}
if (!sv)
return;
if (SvTHINKFIRST(sv)) {
- if (SvIsCOW(sv) || isGV_with_GP(sv))
- sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
- if (IN_PERL_RUNTIME)
Perl_croak_no_modify();
}
if (SvROK(sv)) {
sv_unref(sv);
sv_setiv(sv, i);
}
+ else sv_force_normal_flags(sv, 0);
}
/* Unlike sv_inc we don't have to worry about string-never-numbers
and keeping them magic. But we mustn't warn on punting */
new_SV(sv);
sv_setpvn(sv,s,len);
- /* This code used to a sv_2mortal(), however we now unroll the call to sv_2mortal()
- * and do what it does ourselves here.
- * Since we have asserted that flags can only have the SVf_UTF8 and/or SVs_TEMP flags
- * set above we can use it to enable the sv flags directly (bypassing SvTEMP_on), which
- * in turn means we dont need to mask out the SVf_UTF8 flag below, which means that we
- * eliminate quite a few steps than it looks - Yves (explaining patch by gfx)
- */
+ /* This code used to do a sv_2mortal(), however we now unroll the call to
+ * sv_2mortal() and do what it does ourselves here. Since we have asserted
+ * that flags can only have the SVf_UTF8 and/or SVs_TEMP flags set above we
+ * can use it to enable the sv flags directly (bypassing SvTEMP_on), which
+ * in turn means we dont need to mask out the SVf_UTF8 flag below, which
+ * means that we eliminate quite a few steps than it looks - Yves
+ * (explaining patch by gfx) */
SvFLAGS(sv) |= flags;
dVAR;
if (!sv)
return NULL;
- if (SvREADONLY(sv) && SvIMMORTAL(sv))
+ if (SvIMMORTAL(sv))
return sv;
PUSH_EXTEND_MORTAL__SV_C(sv);
SvTEMP_on(sv);
char todo[PERL_UCHAR_MAX+1];
const char *send;
- if (!stash)
+ if (!stash || SvTYPE(stash) != SVt_PVHV)
return;
if (!s) { /* reset ?? searches */
continue;
gv = MUTABLE_GV(HeVAL(entry));
sv = GvSV(gv);
- if (sv) {
- if (SvTHINKFIRST(sv)) {
- if (!SvREADONLY(sv) && SvROK(sv))
- sv_unref(sv);
- /* XXX Is this continue a bug? Why should THINKFIRST
- exempt us from resetting arrays and hashes? */
- continue;
- }
+ if (sv && !SvREADONLY(sv)) {
+ SV_CHECK_THINKFIRST_COW_DROP(sv);
SvOK_off(sv);
- if (SvTYPE(sv) >= SVt_PV) {
- SvCUR_set(sv, 0);
- if (SvPVX_const(sv) != NULL)
- *SvPVX(sv) = '\0';
- SvTAINT(sv);
- }
}
if (GvAV(gv)) {
av_clear(GvAV(gv));
}
if (GvHV(gv) && !HvNAME_get(GvHV(gv))) {
-#if defined(VMS)
- Perl_die(aTHX_ "Can't reset %%ENV on this system");
-#else /* ! VMS */
hv_clear(GvHV(gv));
-# if defined(USE_ENVIRON_ARRAY)
- if (gv == PL_envgv)
- my_clearenv();
-# endif /* USE_ENVIRON_ARRAY */
-#endif /* VMS */
}
}
}
PERL_ARGS_ASSERT_SV_PVN_FORCE_FLAGS;
if (flags & SV_GMAGIC) SvGETMAGIC(sv);
- if (SvTHINKFIRST(sv) && !SvROK(sv))
+ if (SvTHINKFIRST(sv) && (!SvROK(sv) || SvREADONLY(sv)))
sv_force_normal_flags(sv, 0);
if (SvPOK(sv)) {
char *s;
STRLEN len;
- if (SvREADONLY(sv) && !(flags & SV_MUTABLE_RETURN)) {
- const char * const ref = sv_reftype(sv,0);
- if (PL_op)
- Perl_croak(aTHX_ "Can't coerce readonly %s to string in %s",
- ref, OP_DESC(PL_op));
- else
- Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
- }
if (SvTYPE(sv) > SVt_PVLV
|| isGV_with_GP(sv))
/* diag_listed_as: Can't coerce %s to %s in %s */
? "GLOB" : "SCALAR");
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
- case SVt_BIND: return "BIND";
+ case SVt_INVLIST: return "INVLIST";
case SVt_REGEXP: return "REGEXP";
default: return "UNKNOWN";
}
/*
=for apidoc newSVrv
-Creates a new SV for the RV, C<rv>, to point to. If C<rv> is not an RV then
-it will be upgraded to one. If C<classname> is non-null then the new SV will
-be blessed in the specified package. The new SV is returned and its
-reference count is 1.
+Creates a new SV for the existing RV, C<rv>, to point to. If C<rv> is not an
+RV then it will be upgraded to one. If C<classname> is non-null then the new
+SV will be blessed in the specified package. The new SV is returned and its
+reference count is 1. The reference count 1 is owned by C<rv>.
=cut
*/
PERL_ARGS_ASSERT_SV_BLESS;
+ SvGETMAGIC(sv);
if (!SvROK(sv))
Perl_croak(aTHX_ "Can't bless non-reference value");
tmpRef = SvRV(sv);
if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
- if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
+ if (SvREADONLY(tmpRef))
Perl_croak_no_modify();
if (SvOBJECT(tmpRef)) {
- if (SvTYPE(tmpRef) != SVt_PVIO)
- --PL_sv_objcount;
SvREFCNT_dec(SvSTASH(tmpRef));
}
}
SvOBJECT_on(tmpRef);
- if (SvTYPE(tmpRef) != SVt_PVIO)
- ++PL_sv_objcount;
SvUPGRADE(tmpRef, SVt_PVMG);
SvSTASH_set(tmpRef, MUTABLE_HV(SvREFCNT_inc_simple(stash)));
%-<num>p include an SV with precision <num>
%2p include a HEK
%3p include a HEK with precision of 256
- %<num>p (where num != 2 or 3) reserved for future
+ %4p char* preceded by utf8 flag and length
+ %<num>p (where num is 1 or > 4) reserved for future
extensions
Robin Barker 2005-07-14 (but modified since)
STRLEN n = 0;
if (*q == '-')
sv = *q++;
+ else if (strnEQ(q, UTF8f, sizeof(UTF8f)-1)) { /* UTF8f */
+ /* The argument has already gone through cBOOL, so the cast
+ is safe. */
+ is_utf8 = (bool)va_arg(*args, int);
+ elen = va_arg(*args, UV);
+ eptr = va_arg(*args, char *);
+ q += sizeof(UTF8f)-1;
+ goto string;
+ }
n = expect_number(&q);
if (*q++ == 'p') {
if (sv) { /* SVf */
}
float_converted:
eptr = PL_efloatbuf;
+ if (PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
+ && instr(eptr, SvPVX_const(PL_numeric_radix_sv)))
+ {
+ is_utf8 = TRUE;
+ }
+
break;
/* SPECIAL */
SvANY(dstr) = new_XNV();
SvNV_set(dstr, SvNVX(sstr));
break;
- /* case SVt_BIND: */
default:
{
/* These are all the types that need complex bodies allocating. */
case SVt_PVMG:
case SVt_PVNV:
case SVt_PVIV:
+ case SVt_INVLIST:
case SVt_PV:
assert(sv_type_details->body_size);
if (sv_type_details->arena) {
if (sv_type >= SVt_PVMG) {
if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
+ } else if (sv_type == SVt_PVAV && AvPAD_NAMELIST(dstr)) {
+ NOOP;
} else if (SvMAGIC(dstr))
SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
if (SvOBJECT(dstr) && SvSTASH(dstr))
}
daux->xhv_name_count = saux->xhv_name_count;
+ daux->xhv_fill_lazy = saux->xhv_fill_lazy;
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
? he_dup(saux->xhv_eiter,
}
}
- if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
- ++PL_sv_objcount;
-
return dstr;
}
/* fall through */
case SAVEt_FREESV:
case SAVEt_MORTALIZESV:
+ case SAVEt_READONLY_OFF:
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
break;
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = cophh_copy((COPHH *)ptr);
break;
+ case SAVEt_ADELETE:
+ av = (const AV *)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = av_dup_inc(av, param);
+ i = POPINT(ss,ix);
+ TOPINT(nss,ix) = i;
+ break;
case SAVEt_DELETE:
hv = (const HV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = hv_dup_inc(hv, param);
sv = (const SV *)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup(sv, param);
break;
- case SAVEt_RE_STATE:
- {
- const struct re_save_state *const old_state
- = (struct re_save_state *)
- (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
- struct re_save_state *const new_state
- = (struct re_save_state *)
- (nss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
-
- Copy(old_state, new_state, 1, struct re_save_state);
- ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
-
- new_state->re_state_bostr
- = pv_dup(old_state->re_state_bostr);
- new_state->re_state_regeol
- = pv_dup(old_state->re_state_regeol);
-#ifdef PERL_ANY_COW
- new_state->re_state_nrs
- = sv_dup(old_state->re_state_nrs, param);
-#endif
- new_state->re_state_reg_magic
- = (MAGIC*) any_dup(old_state->re_state_reg_magic,
- proto_perl);
- new_state->re_state_reg_oldcurpm
- = (PMOP*) any_dup(old_state->re_state_reg_oldcurpm,
- proto_perl);
- new_state->re_state_reg_curpm
- = (PMOP*) any_dup(old_state->re_state_reg_curpm,
- proto_perl);
- new_state->re_state_reg_oldsaved
- = pv_dup(old_state->re_state_reg_oldsaved);
- new_state->re_state_reg_poscache
- = pv_dup(old_state->re_state_reg_poscache);
- new_state->re_state_reg_starttry
- = pv_dup(old_state->re_state_reg_starttry);
- break;
- }
case SAVEt_COMPILE_WARNINGS:
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
Zero(&PL_body_roots, 1, PL_body_roots);
PL_sv_count = 0;
- PL_sv_objcount = 0;
PL_sv_root = NULL;
PL_sv_arenaroot = NULL;
#endif
/* RE engine related */
- Zero(&PL_reg_state, 1, struct re_save_state);
PL_regmatch_slab = NULL;
+ PL_reg_curpm = NULL;
PL_sub_generation = proto_perl->Isub_generation;
PL_cryptseen = proto_perl->Icryptseen;
#endif
- PL_hints = proto_perl->Ihints;
-
#ifdef USE_LOCALE_COLLATE
PL_collation_ix = proto_perl->Icollation_ix;
PL_collation_standard = proto_perl->Icollation_standard;
PL_last_swash_tmps = (U8*)NULL;
PL_last_swash_slen = 0;
- PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
if (flags & CLONEf_COPY_STACKS) {
/* regex stuff */
- PL_regdummy = proto_perl->Iregdummy;
PL_colorset = 0; /* reinits PL_colors[] */
/*PL_colors[6] = {0,0,0,0,0,0};*/
hv_ksplit(PL_strtab, HvTOTALKEYS(proto_perl->Istrtab));
ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
+ Zero(PL_sv_consts, SV_CONSTS_COUNT, SV*);
+
/* This PV will be free'd special way so must set it same way op.c does */
PL_compiling.cop_file = savesharedpv(PL_compiling.cop_file);
ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
/* Unicode inversion lists */
PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
-
- PL_PerlSpace = sv_dup_inc(proto_perl->IPerlSpace, param);
- PL_XPerlSpace = sv_dup_inc(proto_perl->IXPerlSpace, param);
-
- PL_L1PosixAlnum = sv_dup_inc(proto_perl->IL1PosixAlnum, param);
- PL_PosixAlnum = sv_dup_inc(proto_perl->IPosixAlnum, param);
-
- PL_L1PosixAlpha = sv_dup_inc(proto_perl->IL1PosixAlpha, param);
- PL_PosixAlpha = sv_dup_inc(proto_perl->IPosixAlpha, param);
-
- PL_PosixBlank = sv_dup_inc(proto_perl->IPosixBlank, param);
- PL_XPosixBlank = sv_dup_inc(proto_perl->IXPosixBlank, param);
-
- PL_L1Cased = sv_dup_inc(proto_perl->IL1Cased, param);
-
- PL_PosixCntrl = sv_dup_inc(proto_perl->IPosixCntrl, param);
- PL_XPosixCntrl = sv_dup_inc(proto_perl->IXPosixCntrl, param);
-
- PL_PosixDigit = sv_dup_inc(proto_perl->IPosixDigit, param);
-
- PL_L1PosixGraph = sv_dup_inc(proto_perl->IL1PosixGraph, param);
- PL_PosixGraph = sv_dup_inc(proto_perl->IPosixGraph, param);
-
- PL_L1PosixLower = sv_dup_inc(proto_perl->IL1PosixLower, param);
- PL_PosixLower = sv_dup_inc(proto_perl->IPosixLower, param);
-
- PL_L1PosixPrint = sv_dup_inc(proto_perl->IL1PosixPrint, param);
- PL_PosixPrint = sv_dup_inc(proto_perl->IPosixPrint, param);
-
- PL_L1PosixPunct = sv_dup_inc(proto_perl->IL1PosixPunct, param);
- PL_PosixPunct = sv_dup_inc(proto_perl->IPosixPunct, param);
-
- PL_PosixSpace = sv_dup_inc(proto_perl->IPosixSpace, param);
- PL_XPosixSpace = sv_dup_inc(proto_perl->IXPosixSpace, param);
-
- PL_L1PosixUpper = sv_dup_inc(proto_perl->IL1PosixUpper, param);
- PL_PosixUpper = sv_dup_inc(proto_perl->IPosixUpper, param);
-
- PL_L1PosixWord = sv_dup_inc(proto_perl->IL1PosixWord, param);
- PL_PosixWord = sv_dup_inc(proto_perl->IPosixWord, param);
-
- PL_PosixXDigit = sv_dup_inc(proto_perl->IPosixXDigit, param);
- PL_XPosixXDigit = sv_dup_inc(proto_perl->IXPosixXDigit, param);
-
- PL_VertSpace = sv_dup_inc(proto_perl->IVertSpace, param);
+ PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
PL_HasMultiCharFold= sv_dup_inc(proto_perl->IHasMultiCharFold, param);
/* utf8 character class swashes */
- PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum, param);
- PL_utf8_alnumc = sv_dup_inc(proto_perl->Iutf8_alnumc, param);
- PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha, param);
- PL_utf8_graph = sv_dup_inc(proto_perl->Iutf8_graph, param);
- PL_utf8_digit = sv_dup_inc(proto_perl->Iutf8_digit, param);
- PL_utf8_upper = sv_dup_inc(proto_perl->Iutf8_upper, param);
- PL_utf8_lower = sv_dup_inc(proto_perl->Iutf8_lower, param);
- PL_utf8_print = sv_dup_inc(proto_perl->Iutf8_print, param);
- PL_utf8_punct = sv_dup_inc(proto_perl->Iutf8_punct, param);
+ for (i = 0; i < POSIX_SWASH_COUNT; i++) {
+ PL_utf8_swash_ptrs[i] = sv_dup_inc(proto_perl->Iutf8_swash_ptrs[i], param);
+ }
+ for (i = 0; i < POSIX_CC_COUNT; i++) {
+ PL_Posix_ptrs[i] = sv_dup_inc(proto_perl->IPosix_ptrs[i], param);
+ PL_L1Posix_ptrs[i] = sv_dup_inc(proto_perl->IL1Posix_ptrs[i], param);
+ PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+ }
PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param);
PL_utf8_X_regular_begin = sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param);
PL_utf8_X_extend = sv_dup_inc(proto_perl->Iutf8_X_extend, param);
- PL_utf8_X_LVT = sv_dup_inc(proto_perl->Iutf8_X_LVT, param);
PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param);
PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param);
PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower, param);
PL_utf8_idstart = sv_dup_inc(proto_perl->Iutf8_idstart, param);
PL_utf8_xidstart = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
+ PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param);
PL_utf8_xidcont = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
PL_utf8_foldable = sv_dup_inc(proto_perl->Iutf8_foldable, param);
PL_utf8_charname_begin = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
- PL_ASCII = sv_dup_inc(proto_perl->IASCII, param);
- PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
- PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
if (proto_perl->Ipsig_pend) {
Newxz(PL_psig_pend, SIG_SIZE, int);
PL_errors = sv_dup_inc(proto_perl->Ierrors, param);
PL_sortcop = (OP*)any_dup(proto_perl->Isortcop, proto_perl);
- PL_sortstash = hv_dup(proto_perl->Isortstash, param);
PL_firstgv = gv_dup(proto_perl->Ifirstgv, param);
PL_secondgv = gv_dup(proto_perl->Isecondgv, param);
void
Perl_init_constants(pTHX)
{
- SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
+ SvREFCNT(&PL_sv_undef) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL;
SvANY(&PL_sv_undef) = NULL;
SvANY(&PL_sv_no) = new_XPVNV();
- SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
+ SvREFCNT(&PL_sv_no) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_no) = SVt_PVNV|SVf_READONLY
|SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK;
SvANY(&PL_sv_yes) = new_XPVNV();
- SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ SvREFCNT(&PL_sv_yes) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_yes) = SVt_PVNV|SVf_READONLY
|SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK;
break;
}
else {
+ SV * const opsv = cSVOPx_sv(kid);
+ const IV opsviv = SvIV(opsv);
SV * const * const svp = av_fetch(MUTABLE_AV(sv),
- negate ? - SvIV(cSVOPx_sv(kid)) : SvIV(cSVOPx_sv(kid)),
+ negate ? - opsviv : opsviv,
FALSE);
if (!svp || *svp != uninit_sv)
break;
https://perl5.git.perl.org / perl5.git / blobdiff