sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVIO) {
GV * const gv = MUTABLE_GV(sv_newmortal());
- gv_init(gv, 0, "", 0, 0);
+ gv_init(gv, 0, "$__ANONIO__", 11, 0);
GvIOp(gv) = MUTABLE_IO(sv);
SvREFCNT_inc_void_NN(sv);
sv = MUTABLE_SV(gv);
if (SvREADONLY(sv))
Perl_croak_no_modify(aTHX);
if (cUNOP->op_targ) {
- STRLEN len;
SV * const namesv = PAD_SV(cUNOP->op_targ);
- const char * const name = SvPV(namesv, len);
gv = MUTABLE_GV(newSV(0));
- gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
+ gv_init_sv(gv, CopSTASH(PL_curcop), namesv, 0);
}
else {
const char * const name = CopSTASHPV(PL_curcop);
- gv = newGVgen(name);
+ gv = newGVgen_flags(name,
+ HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 );
}
prepare_SV_for_RV(sv);
SvRV_set(sv, MUTABLE_SV(gv));
}
if (noinit)
{
- STRLEN len;
- const char * const nambeg = SvPV_nomg_const(sv, len);
- if (!(sv = MUTABLE_SV(gv_fetchpvn_flags(
- nambeg, len, SvUTF8(sv)|GV_ADDMG, SVt_PVGV
+ if (!(sv = MUTABLE_SV(gv_fetchsv_nomg(
+ sv, GV_ADDMG, SVt_PVGV
))))
return &PL_sv_undef;
}
things. */
return sv;
}
- {
- STRLEN len;
- const char * const nambeg = SvPV_nomg_const(sv, len);
- sv = MUTABLE_SV(
- gv_fetchpvn_flags(
- nambeg, len, GV_ADD | SvUTF8(sv), SVt_PVGV
- )
- );
- }
+ sv = MUTABLE_SV(gv_fetchsv_nomg(sv, GV_ADD, SVt_PVGV));
}
/* FAKE globs in the symbol table cause weird bugs (#77810) */
SvFAKE_off(sv);
if ((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
- STRLEN len;
- const char * const nambeg = SvPV_nomg_const(sv, len);
- if (!(gv = gv_fetchpvn_flags(
- nambeg, len, SvUTF8(sv)|GV_ADDMG, type
- )))
+ if (!(gv = gv_fetchsv_nomg(sv, GV_ADDMG, type)))
{
**spp = &PL_sv_undef;
return NULL;
}
}
else {
- STRLEN len;
- const char * const nambeg = SvPV_nomg_const(sv, len);
- gv = gv_fetchpvn_flags(nambeg, len, GV_ADD | SvUTF8(sv), type);
+ gv = gv_fetchsv_nomg(sv, GV_ADD, type);
}
return gv;
}
}
SETs(*sv);
} else {
- SETs(sv_2mortal(newSViv(
- AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop)
- )));
+ SETs(sv_2mortal(newSViv(AvFILL(MUTABLE_AV(av)))));
}
RETURN;
}
I32 i = mg->mg_len;
if (DO_UTF8(sv))
sv_pos_b2u(sv, &i);
- PUSHi(i + CopARYBASE_get(PL_curcop));
+ PUSHi(i);
RETURN;
}
}
if (CvCLONE(cv))
cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
if ((PL_op->op_private & OPpLVAL_INTRO)) {
- if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
+ if (gv && GvCV(gv) == cv && (gv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), GvNAMEUTF8(gv) ? SVf_UTF8 : 0)))
cv = GvCV(gv);
if (!CvLVALUE(cv))
DIE(aTHX_ "Can't modify non-lvalue subroutine call");
}
cv = sv_2cv(TOPs, &stash, &gv, 0);
if (cv && SvPOK(cv))
- ret = newSVpvn_flags(SvPVX_const(cv), SvCUR(cv), SVs_TEMP);
+ ret = newSVpvn_flags(
+ CvPROTO(cv), CvPROTOLEN(cv), SVs_TEMP | SvUTF8(cv)
+ );
set:
SETs(ret);
RETURN;
PP(pp_ref)
{
dVAR; dSP; dTARGET;
- const char *pv;
SV * const sv = POPs;
if (sv)
if (!sv || !SvROK(sv))
RETPUSHNO;
- pv = sv_reftype(SvRV(sv),TRUE);
- PUSHp(pv, strlen(pv));
+ (void)sv_ref(TARG,SvRV(sv),TRUE);
+ PUSHTARG;
RETURN;
}
if (len == 0)
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Explicit blessing to '' (assuming package main)");
- stash = gv_stashpvn(ptr, len, GV_ADD);
+ stash = gv_stashpvn(ptr, len, GV_ADD|SvUTF8(ssv));
}
(void)sv_bless(TOPs, stash);
dVAR; dSP;
SV *sv = POPs;
- const char * const elem = SvPV_nolen_const(sv);
+ STRLEN len;
+ const char * const elem = SvPV_const(sv, len);
GV * const gv = MUTABLE_GV(POPs);
SV * tmpRef = NULL;
const char * const second_letter = elem + 1;
switch (*elem) {
case 'A':
- if (strEQ(second_letter, "RRAY"))
+ if (len == 5 && strEQ(second_letter, "RRAY"))
tmpRef = MUTABLE_SV(GvAV(gv));
break;
case 'C':
- if (strEQ(second_letter, "ODE"))
+ if (len == 4 && strEQ(second_letter, "ODE"))
tmpRef = MUTABLE_SV(GvCVu(gv));
break;
case 'F':
- if (strEQ(second_letter, "ILEHANDLE")) {
+ if (len == 10 && strEQ(second_letter, "ILEHANDLE")) {
/* finally deprecated in 5.8.0 */
deprecate("*glob{FILEHANDLE}");
tmpRef = MUTABLE_SV(GvIOp(gv));
}
else
- if (strEQ(second_letter, "ORMAT"))
+ if (len == 6 && strEQ(second_letter, "ORMAT"))
tmpRef = MUTABLE_SV(GvFORM(gv));
break;
case 'G':
- if (strEQ(second_letter, "LOB"))
+ if (len == 4 && strEQ(second_letter, "LOB"))
tmpRef = MUTABLE_SV(gv);
break;
case 'H':
- if (strEQ(second_letter, "ASH"))
+ if (len == 4 && strEQ(second_letter, "ASH"))
tmpRef = MUTABLE_SV(GvHV(gv));
break;
case 'I':
- if (*second_letter == 'O' && !elem[2])
+ if (*second_letter == 'O' && !elem[2] && len == 2)
tmpRef = MUTABLE_SV(GvIOp(gv));
break;
case 'N':
- if (strEQ(second_letter, "AME"))
+ if (len == 4 && strEQ(second_letter, "AME"))
sv = newSVhek(GvNAME_HEK(gv));
break;
case 'P':
- if (strEQ(second_letter, "ACKAGE")) {
+ if (len == 7 && strEQ(second_letter, "ACKAGE")) {
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 (strEQ(second_letter, "CALAR"))
+ if (len == 6 && strEQ(second_letter, "CALAR"))
tmpRef = GvSVn(gv);
break;
}
break;
case SVt_PVCV:
if (cv_const_sv((const CV *)sv))
- Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
- CvANON((const CV *)sv) ? "(anonymous)"
- : GvENAME(CvGV((const CV *)sv)));
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+ "Constant subroutine %"SVf" undefined",
+ SVfARG(CvANON((const CV *)sv)
+ ? newSVpvs_flags("(anonymous)", SVs_TEMP)
+ : sv_2mortal(newSVhek(GvENAME_HEK(CvGV((const CV *)sv))))));
/* FALLTHROUGH */
case SVt_PVFM:
{
RETPUSHUNDEF;
}
-PP(pp_predec)
-{
- dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
- Perl_croak_no_modify(aTHX);
- if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
- && SvIVX(TOPs) != IV_MIN)
- {
- SvIV_set(TOPs, SvIVX(TOPs) - 1);
- SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
- }
- else
- sv_dec(TOPs);
- SvSETMAGIC(TOPs);
- return NORMAL;
-}
-
PP(pp_postinc)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ const bool inc =
+ PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
+ if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
Perl_croak_no_modify(aTHX);
if (SvROK(TOPs))
TARG = sv_newmortal();
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
- && SvIVX(TOPs) != IV_MAX)
+ && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
{
- SvIV_set(TOPs, SvIVX(TOPs) + 1);
+ SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1));
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
- else
+ else if (inc)
sv_inc_nomg(TOPs);
+ else sv_dec_nomg(TOPs);
SvSETMAGIC(TOPs);
/* special case for undef: see thread at 2003-03/msg00536.html in archive */
- if (!SvOK(TARG))
+ if (inc && !SvOK(TARG))
sv_setiv(TARG, 0);
SETs(TARG);
return NORMAL;
}
-PP(pp_postdec)
-{
- dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
- Perl_croak_no_modify(aTHX);
- if (SvROK(TOPs))
- TARG = sv_newmortal();
- sv_setsv(TARG, TOPs);
- if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
- && SvIVX(TOPs) != IV_MIN)
- {
- SvIV_set(TOPs, SvIVX(TOPs) - 1);
- SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
- }
- else
- sv_dec_nomg(TOPs);
- SvSETMAGIC(TOPs);
- SETs(TARG);
- return NORMAL;
-}
-
/* Ordinary operators. */
PP(pp_pow)
IV len_iv = 0;
int len_is_uv = 1;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ const bool rvalue = (GIMME_V != G_VOID);
const char *tmps;
- const IV arybase = CopARYBASE_get(PL_curcop);
SV *repl_sv = NULL;
const char *repl = NULL;
STRLEN repl_len;
if (num_args > 3) {
if((repl_sv = POPs)) {
repl = SvPV_const(repl_sv, repl_len);
- repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
+ repl_is_utf8 = DO_UTF8(repl_sv) && repl_len;
}
else num_args--;
}
else
utf8_curlen = 0;
- if ( (pos1_is_uv && arybase < 0) || (pos1_iv >= arybase) ) { /* pos >= $[ */
- UV pos1_uv = pos1_iv-arybase;
- /* Overflow can occur when $[ < 0 */
- if (arybase < 0 && pos1_uv < (UV)pos1_iv)
- goto bound_fail;
- pos1_iv = pos1_uv;
- pos1_is_uv = 1;
- }
- else if (pos1_is_uv ? (UV)pos1_iv > 0 : pos1_iv > 0) {
- goto bound_fail; /* $[=3; substr($_,2,...) */
- }
- else { /* pos < $[ */
- if (pos1_iv == 0) { /* $[=1; substr($_,0,...) */
- pos1_iv = curlen;
- pos1_is_uv = 1;
- } else {
- if (curlen) {
- pos1_is_uv = curlen-1 > ~(UV)pos1_iv;
- pos1_iv += curlen;
- }
- }
- }
- if (pos1_is_uv || pos1_iv > 0) {
- if ((UV)pos1_iv > curlen)
- goto bound_fail;
+ if (!pos1_is_uv && pos1_iv < 0 && curlen) {
+ pos1_is_uv = curlen-1 > ~(UV)pos1_iv;
+ pos1_iv += curlen;
}
+ if ((pos1_is_uv || pos1_iv > 0) && (UV)pos1_iv > curlen)
+ goto bound_fail;
if (num_args > 2) {
if (!len_is_uv && len_iv < 0) {
RETURN;
}
- SvTAINTED_off(TARG); /* decontaminate */
- SvUTF8_off(TARG); /* decontaminate */
-
tmps += byte_pos;
- sv_setpvn(TARG, tmps, byte_len);
+
+ if (rvalue) {
+ SvTAINTED_off(TARG); /* decontaminate */
+ SvUTF8_off(TARG); /* decontaminate */
+ sv_setpvn(TARG, tmps, byte_len);
#ifdef USE_LOCALE_COLLATE
- sv_unmagic(TARG, PERL_MAGIC_collxfrm);
+ sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
- if (utf8_curlen)
- SvUTF8_on(TARG);
+ if (utf8_curlen)
+ SvUTF8_on(TARG);
+ }
if (repl) {
SV* repl_sv_copy = NULL;
repl_sv_copy = newSVsv(repl_sv);
sv_utf8_upgrade(repl_sv_copy);
repl = SvPV_const(repl_sv_copy, repl_len);
- repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
+ repl_is_utf8 = DO_UTF8(repl_sv_copy) && repl_len;
}
if (!SvOK(sv))
sv_setpvs(sv, "");
}
}
SPAGAIN;
- SvSETMAGIC(TARG);
- PUSHs(TARG);
+ if (rvalue) {
+ SvSETMAGIC(TARG);
+ PUSHs(TARG);
+ }
RETURN;
bound_fail:
I32 retval;
const char *big_p;
const char *little_p;
- const I32 arybase = CopARYBASE_get(PL_curcop);
bool big_utf8;
bool little_utf8;
const bool is_index = PL_op->op_type == OP_INDEX;
const bool threeargs = MAXARG >= 3 && (TOPs || ((void)POPs,0));
- if (threeargs) {
- /* arybase is in characters, like offset, so combine prior to the
- UTF-8 to bytes calculation. */
- offset = POPi - arybase;
- }
+ if (threeargs)
+ offset = POPi;
little = POPs;
big = POPs;
big_p = SvPV_const(big, biglen);
}
SvREFCNT_dec(temp);
fail:
- PUSHi(retval + arybase);
+ PUSHi(retval);
RETURN;
}
bool in_iota_subscript = FALSE;
while (s < send) {
+ STRLEN u;
+ STRLEN ulen;
+ UV uv;
if (in_iota_subscript && ! is_utf8_mark(s)) {
+
/* A non-mark. Time to output the iota subscript */
#define GREEK_CAPITAL_LETTER_IOTA 0x0399
#define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
CAT_UNI_TO_UTF8_TWO_BYTE(d, GREEK_CAPITAL_LETTER_IOTA);
in_iota_subscript = FALSE;
- }
-
- /* If the UTF-8 character is invariant, then it is in the range
- * known by the standard macro; result is only one byte long */
- if (UTF8_IS_INVARIANT(*s)) {
- *d++ = toUPPER(*s);
- s++;
- }
- else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
-
- /* Likewise, if it fits in a byte, its case change is in our
- * table */
- U8 orig = TWO_BYTE_UTF8_TO_UNI(*s, *(s+1));
- U8 upper = toUPPER_LATIN1_MOD(orig);
- CAT_TWO_BYTE_UNI_UPPER_MOD(d, orig, upper);
- s += 2;
- }
- else {
-
- /* Otherwise, need the general UTF-8 case. Get the changed
- * case value and copy it to the output buffer */
+ }
- const STRLEN u = UTF8SKIP(s);
- STRLEN ulen;
+ /* Then handle the current character. Get the changed case value
+ * and copy it to the output buffer */
- const UV uv = toUPPER_utf8(s, tmpbuf, &ulen);
- if (uv == GREEK_CAPITAL_LETTER_IOTA
- && utf8_to_uvchr(s, 0) == COMBINING_GREEK_YPOGEGRAMMENI)
- {
- in_iota_subscript = TRUE;
- }
- else {
- if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
- /* If the eventually required minimum size outgrows
- * the available space, we need to grow. */
- const UV o = d - (U8*)SvPVX_const(dest);
-
- /* If someone uppercases one million U+03B0s we
- * SvGROW() one million times. Or we could try
- * guessing how much to 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;
- }
- Copy(tmpbuf, d, ulen, U8);
- d += ulen;
- }
- s += u;
- }
+ u = UTF8SKIP(s);
+ uv = toUPPER_utf8(s, tmpbuf, &ulen);
+ if (uv == GREEK_CAPITAL_LETTER_IOTA
+ && utf8_to_uvchr(s, 0) == COMBINING_GREEK_YPOGEGRAMMENI)
+ {
+ in_iota_subscript = TRUE;
+ }
+ else {
+ if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
+ /* If the eventually required minimum size outgrows the
+ * available space, we need to grow. */
+ const UV o = d - (U8*)SvPVX_const(dest);
+
+ /* If someone uppercases one million U+03B0s we SvGROW()
+ * one million times. Or we could try guessing how much to
+ * 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;
+ }
+ Copy(tmpbuf, d, ulen, U8);
+ d += ulen;
+ }
+ s += u;
}
if (in_iota_subscript) {
CAT_UNI_TO_UTF8_TWO_BYTE(d, GREEK_CAPITAL_LETTER_IOTA);
else {
for (; s < send; d++, s++) {
*d = toUPPER_LATIN1_MOD(*s);
- if (*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS) continue;
+ if (LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) continue;
/* The mainstream case is the tight loop above. To avoid
* extra tests in that, all three characters that require
U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
while (s < send) {
- if (UTF8_IS_INVARIANT(*s)) {
+ const STRLEN u = UTF8SKIP(s);
+ STRLEN ulen;
- /* Invariant characters use the standard mappings compiled in.
- */
- *d++ = toLOWER(*s);
- s++;
- }
- else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
+ toLOWER_utf8(s, tmpbuf, &ulen);
- /* As do the ones in the Latin1 range */
- U8 lower = toLOWER_LATIN1(TWO_BYTE_UTF8_TO_UNI(*s, *(s+1)));
- CAT_UNI_TO_UTF8_TWO_BYTE(d, lower);
- s += 2;
- }
- else {
- /* Here, is utf8 not in Latin-1 range, have to go out and get
- * the mappings from the tables. */
+ /* Here is where we would do context-sensitive actions. See the
+ * commit message for this comment for why there isn't any */
- const STRLEN u = UTF8SKIP(s);
- STRLEN ulen;
+ if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
-#ifndef CONTEXT_DEPENDENT_CASING
- toLOWER_utf8(s, tmpbuf, &ulen);
-#else
-/* This is ifdefd out because it probably is the wrong thing to do. The right
- * thing is probably to have an I/O layer that converts final sigma to regular
- * on input and vice versa (under the correct circumstances) on output. In
- * effect, the final sigma is just a glyph variation when the regular one
- * occurs at the end of a word. And we don't really know what's going to be
- * the end of the word until it is finally output, as splitting and joining can
- * occur at any time and change what once was the word end to be in the middle,
- * and vice versa. */
-
- const UV uv = toLOWER_utf8(s, tmpbuf, &ulen);
-
- /* If the lower case is a small sigma, it may be that we need
- * to change it to a final sigma. This happens at the end of
- * a word that contains more than just this character, and only
- * when we started with a capital sigma. */
- if (uv == UNICODE_GREEK_SMALL_LETTER_SIGMA &&
- s > send - len && /* Makes sure not the first letter */
- utf8_to_uvchr(s, 0) == UNICODE_GREEK_CAPITAL_LETTER_SIGMA
- ) {
-
- /* We use the algorithm in:
- * http://www.unicode.org/versions/Unicode5.0.0/ch03.pdf (C
- * is a CAPITAL SIGMA): If C is preceded by a sequence
- * consisting of a cased letter and a case-ignorable
- * sequence, and C is not followed by a sequence consisting
- * of a case ignorable sequence and then a cased letter,
- * then when lowercasing C, C becomes a final sigma */
-
- /* To determine if this is the end of a word, need to peek
- * ahead. Look at the next character */
- const U8 *peek = s + u;
-
- /* Skip any case ignorable characters */
- while (peek < send && is_utf8_case_ignorable(peek)) {
- peek += UTF8SKIP(peek);
- }
-
- /* If we reached the end of the string without finding any
- * non-case ignorable characters, or if the next such one
- * is not-cased, then we have met the conditions for it
- * being a final sigma with regards to peek ahead, and so
- * must do peek behind for the remaining conditions. (We
- * know there is stuff behind to look at since we tested
- * above that this isn't the first letter) */
- if (peek >= send || ! is_utf8_cased(peek)) {
- peek = utf8_hop(s, -1);
-
- /* Here are at the beginning of the first character
- * before the original upper case sigma. Keep backing
- * up, skipping any case ignorable characters */
- while (is_utf8_case_ignorable(peek)) {
- peek = utf8_hop(peek, -1);
- }
+ /* If the eventually required minimum size outgrows the
+ * available space, we need to grow. */
+ const UV o = d - (U8*)SvPVX_const(dest);
- /* Here peek points to the first byte of the closest
- * non-case-ignorable character before the capital
- * sigma. If it is cased, then by the Unicode
- * algorithm, we should use a small final sigma instead
- * of what we have */
- if (is_utf8_cased(peek)) {
- STORE_UNI_TO_UTF8_TWO_BYTE(tmpbuf,
- UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA);
- }
- }
- }
- else { /* Not a context sensitive mapping */
-#endif /* End of commented out context sensitive */
- if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
-
- /* If the eventually required minimum size outgrows
- * the available space, we need to grow. */
- const UV o = d - (U8*)SvPVX_const(dest);
-
- /* If someone lowercases one million U+0130s we
- * SvGROW() one million times. Or we could try
- * guessing how much to allocate without allocating too
- * much. Such is life. 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;
- }
-#ifdef CONTEXT_DEPENDENT_CASING
- }
-#endif
- /* Copy the newly lowercased letter to the output buffer we're
- * building */
- Copy(tmpbuf, d, ulen, U8);
- d += ulen;
- s += u;
+ /* If someone lowercases one million U+0130s we SvGROW() one
+ * million times. Or we could try guessing how much to
+ * allocate without allocating too much. Such is life.
+ * 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;
}
+
+ /* Copy the newly lowercased letter to the output buffer we're
+ * building */
+ Copy(tmpbuf, d, ulen, U8);
+ d += ulen;
+ s += u;
} /* End of looping through the source string */
SvUTF8_on(dest);
*d = '\0';
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
if (SvTYPE(av) == SVt_PVAV) {
- const I32 arybase = CopARYBASE_get(PL_curcop);
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
bool can_preserve = FALSE;
I32 elem = SvIV(*MARK);
bool preeminent = TRUE;
- if (elem > 0)
- elem -= arybase;
if (localizing && can_preserve) {
/* If we can determine whether the element exist,
* Try to preserve the existenceness of a tied array
}
EXTEND(SP, 2);
- mPUSHi(CopARYBASE_get(PL_curcop) + current);
+ mPUSHi(current);
if (gimme == G_ARRAY) {
SV **const element = av_fetch(array, current, 0);
PUSHs(element ? *element : &PL_sv_undef);
}
else if (gimme == G_ARRAY) {
IV n = Perl_av_len(aTHX_ array);
- IV i = CopARYBASE_get(PL_curcop);
+ IV i;
EXTEND(SP, n + 1);
if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) {
- n += i;
- for (; i <= n; i++) {
+ for (i = 0; i <= n; i++) {
mPUSHi(i);
}
}
SV ** const lastlelem = PL_stack_base + POPMARK;
SV ** const firstlelem = PL_stack_base + POPMARK + 1;
register SV ** const firstrelem = lastlelem + 1;
- const I32 arybase = CopARYBASE_get(PL_curcop);
I32 is_something_there = FALSE;
register const I32 max = lastrelem - lastlelem;
I32 ix = SvIV(*lastlelem);
if (ix < 0)
ix += max;
- else
- ix -= arybase;
if (ix < 0 || ix >= max)
*firstlelem = &PL_sv_undef;
else
I32 ix = SvIV(*lelem);
if (ix < 0)
ix += max;
- else
- ix -= arybase;
if (ix < 0 || ix >= max)
*lelem = &PL_sv_undef;
else {
offset = i = SvIV(*MARK);
if (offset < 0)
offset += AvFILLp(ary) + 1;
- else
- offset -= CopARYBASE_get(PL_curcop);
if (offset < 0)
DIE(aTHX_ PL_no_aelem, i);
if (++MARK < SP) {
https://perl5.git.perl.org / perl5.git / blobdiff