GV * const gv = (GV*) sv_newmortal();
gv_init(gv, 0, "", 0, 0);
GvIOp(gv) = (IO *)sv;
- (void)SvREFCNT_inc(sv);
+ SvREFCNT_inc_void_NN(sv);
sv = (SV*) gv;
}
else if (SvTYPE(sv) != SVt_PVGV)
}
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
- if (SvPVX_const(sv)) {
+ else if (SvPVX_const(sv)) {
SvPV_free(sv);
SvLEN_set(sv, 0);
SvCUR_set(sv, 0);
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
+ case SVt_PVFM:
+ case SVt_PVIO:
DIE(aTHX_ "Not a SCALAR reference");
}
}
if (LvTARG(TARG) != sv) {
if (LvTARG(TARG))
SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc(sv);
+ LvTARG(TARG) = SvREFCNT_inc_simple(sv);
}
PUSHs(TARG); /* no SvSETMAGIC */
RETURN;
I32 i = mg->mg_len;
if (DO_UTF8(sv))
sv_pos_b2u(sv, &i);
- PUSHi(i + PL_curcop->cop_arybase);
+ PUSHi(i + CopARYBASE_get(PL_curcop));
RETURN;
}
}
if (!(sv = LvTARG(sv)))
sv = &PL_sv_undef;
else
- (void)SvREFCNT_inc(sv);
+ SvREFCNT_inc_void_NN(sv);
}
else if (SvTYPE(sv) == SVt_PVAV) {
if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
av_reify((AV*)sv);
SvTEMP_off(sv);
- (void)SvREFCNT_inc(sv);
+ SvREFCNT_inc_void_NN(sv);
}
else if (SvPADTMP(sv) && !IS_PADGV(sv))
sv = newSVsv(sv);
else {
SvTEMP_off(sv);
- (void)SvREFCNT_inc(sv);
+ SvREFCNT_inc_void_NN(sv);
}
rv = sv_newmortal();
sv_upgrade(rv, SVt_RV);
if (SvSCREAM(sv))
RETPUSHYES;
}
- else {
- if (PL_lastscream) {
- SvSCREAM_off(PL_lastscream);
- SvREFCNT_dec(PL_lastscream);
- }
- PL_lastscream = SvREFCNT_inc(sv);
+ s = (unsigned char*)(SvPV(sv, len));
+ pos = len;
+ if (pos <= 0 || !SvPOK(sv)) {
+ /* No point in studying a zero length string, and not safe to study
+ anything that doesn't appear to be a simple scalar (and hence might
+ change between now and when the regexp engine runs without our set
+ magic ever running) such as a reference to an object with overloaded
+ stringification. */
+ RETPUSHNO;
+ }
+
+ if (PL_lastscream) {
+ SvSCREAM_off(PL_lastscream);
+ SvREFCNT_dec(PL_lastscream);
}
+ PL_lastscream = SvREFCNT_inc_simple(sv);
s = (unsigned char*)(SvPV(sv, len));
pos = len;
if (cv_const_sv((CV*)sv) && ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case SVt_PVFM:
{
/* let user-undef'd sub keep its identity */
#endif
{
dPOPTOPnnrl;
+
+#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG)
+ /*
+ We are building perl with long double support and are on an AIX OS
+ afflicted with a powl() function that wrongly returns NaNQ for any
+ negative base. This was reported to IBM as PMR #23047-379 on
+ 03/06/2006. The problem exists in at least the following versions
+ of AIX and the libm fileset, and no doubt others as well:
+
+ AIX 4.3.3-ML10 bos.adt.libm 4.3.3.50
+ AIX 5.1.0-ML04 bos.adt.libm 5.1.0.29
+ AIX 5.2.0 bos.adt.libm 5.2.0.85
+
+ So, until IBM fixes powl(), we provide the following workaround to
+ handle the problem ourselves. Our logic is as follows: for
+ negative bases (left), we use fmod(right, 2) to check if the
+ exponent is an odd or even integer:
+
+ - if odd, powl(left, right) == -powl(-left, right)
+ - if even, powl(left, right) == powl(-left, right)
+
+ If the exponent is not an integer, the result is rightly NaNQ, so
+ we just return that (as NV_NAN).
+ */
+
+ if (left < 0.0) {
+ NV mod2 = Perl_fmod( right, 2.0 );
+ if (mod2 == 1.0 || mod2 == -1.0) { /* odd integer */
+ SETn( -Perl_pow( -left, right) );
+ } else if (mod2 == 0.0) { /* even integer */
+ SETn( Perl_pow( -left, right) );
+ } else { /* fractional power */
+ SETn( NV_NAN );
+ }
+ } else {
+ SETn( Perl_pow( left, right) );
+ }
+#else
SETn( Perl_pow( left, right) );
+#endif /* HAS_AIX_POWL_NEG_BASE_BUG */
+
#ifdef PERL_PRESERVE_IVUV
if (is_int)
SvIV_please(TOPs);
bhigh = blow >> (4 * sizeof (UV));
blow &= botmask;
if (ahigh && bhigh) {
+ /*EMPTY*/;
/* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000
which is overflow. Drop to NVs below. */
} else if (!ahigh && !bhigh) {
}
#endif
{
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ dPOPTOPnnrl;
+ if (Perl_isnan(left) || Perl_isnan(right))
+ RETSETNO;
+ SETs(boolSV(left < right));
+#else
dPOPnv;
SETs(boolSV(TOPn < value));
+#endif
RETURN;
}
}
}
#endif
{
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ dPOPTOPnnrl;
+ if (Perl_isnan(left) || Perl_isnan(right))
+ RETSETNO;
+ SETs(boolSV(left > right));
+#else
dPOPnv;
SETs(boolSV(TOPn > value));
+#endif
RETURN;
}
}
}
#endif
{
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ dPOPTOPnnrl;
+ if (Perl_isnan(left) || Perl_isnan(right))
+ RETSETNO;
+ SETs(boolSV(left <= right));
+#else
dPOPnv;
SETs(boolSV(TOPn <= value));
+#endif
RETURN;
}
}
}
#endif
{
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ dPOPTOPnnrl;
+ if (Perl_isnan(left) || Perl_isnan(right))
+ RETSETNO;
+ SETs(boolSV(left >= right));
+#else
dPOPnv;
SETs(boolSV(TOPn >= value));
+#endif
RETURN;
}
}
}
#endif
{
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ dPOPTOPnnrl;
+ if (Perl_isnan(left) || Perl_isnan(right))
+ RETSETYES;
+ SETs(boolSV(left != right));
+#else
dPOPnv;
SETs(boolSV(TOPn != value));
+#endif
RETURN;
}
}
}
}
-PP(pp_bit_xor)
-{
- dVAR; dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
- {
- dPOPTOPssrl;
- SvGETMAGIC(left);
- SvGETMAGIC(right);
- if (SvNIOKp(left) || SvNIOKp(right)) {
- if (PL_op->op_private & HINT_INTEGER) {
- const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
- SETi(i);
- }
- else {
- const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
- SETu(u);
- }
- }
- else {
- do_vop(PL_op->op_type, TARG, left, right);
- SETTARG;
- }
- RETURN;
- }
-}
-
PP(pp_bit_or)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+ dVAR; dSP; dATARGET;
+ const int op_type = PL_op->op_type;
+
+ tryAMAGICbin_var((op_type == OP_BIT_OR ? bor_amg : bxor_amg), opASSIGN);
{
dPOPTOPssrl;
SvGETMAGIC(left);
SvGETMAGIC(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
- SETi(i);
+ const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
+ const IV r = SvIV_nomg(right);
+ const IV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
+ SETi(result);
}
else {
- const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
- SETu(u);
+ const UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0);
+ const UV r = SvUV_nomg(right);
+ const UV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
+ SETu(result);
}
}
else {
- do_vop(PL_op->op_type, TARG, left, right);
+ do_vop(op_type, TARG, left, right);
SETTARG;
}
RETURN;
if (SvUTF8(TARG)) {
/* Calculate exact length, let's not estimate. */
STRLEN targlen = 0;
- U8 *result;
- U8 *send;
STRLEN l;
UV nchar = 0;
UV nwide = 0;
+ U8 * const send = tmps + len;
+ U8 * const origtmps = tmps;
+ const UV utf8flags = UTF8_ALLOW_ANYUV;
- send = tmps + len;
while (tmps < send) {
- const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
- tmps += UTF8SKIP(tmps);
+ const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
+ tmps += l;
targlen += UNISKIP(~c);
nchar++;
if (c > 0xff)
}
/* Now rewind strings and write them. */
- tmps -= len;
+ tmps = origtmps;
if (nwide) {
- Newxz(result, targlen + 1, U8);
+ U8 *result;
+ U8 *p;
+
+ Newx(result, targlen + 1, U8);
+ p = result;
while (tmps < send) {
- const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
- tmps += UTF8SKIP(tmps);
- result = uvchr_to_utf8_flags(result, ~c, UNICODE_ALLOW_ANY);
+ const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
+ tmps += l;
+ p = uvchr_to_utf8_flags(p, ~c, UNICODE_ALLOW_ANY);
}
- *result = '\0';
- result -= targlen;
- sv_setpvn(TARG, (char*)result, targlen);
+ *p = '\0';
+ sv_usepvn_flags(TARG, (char*)result, targlen,
+ SV_HAS_TRAILING_NUL);
SvUTF8_on(TARG);
}
else {
- Newxz(result, nchar + 1, U8);
+ U8 *result;
+ U8 *p;
+
+ Newx(result, nchar + 1, U8);
+ p = result;
while (tmps < send) {
- const U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
- tmps += UTF8SKIP(tmps);
- *result++ = ~c;
+ const U8 c = (U8)utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
+ tmps += l;
+ *p++ = ~c;
}
- *result = '\0';
- result -= nchar;
- sv_setpvn(TARG, (char*)result, nchar);
+ *p = '\0';
+ sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
SvUTF8_off(TARG);
}
- Safefree(result);
SETs(TARG);
RETURN;
}
PP(pp_i_divide)
{
+ IV num;
dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPiv;
if (value == 0)
- DIE(aTHX_ "Illegal division by zero");
- value = POPi / value;
+ DIE(aTHX_ "Illegal division by zero");
+ num = POPi;
+
+ /* avoid FPE_INTOVF on some platforms when num is IV_MIN */
+ if (value == -1)
+ value = - num;
+ else
+ value = num / value;
PUSHi( value );
RETURN;
}
dPOPTOPiirl;
if (!right)
DIE(aTHX_ "Illegal modulus zero");
- SETi( left % right );
+ /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
+ if (right == -1)
+ SETi( 0 );
+ else
+ SETi( left % right );
RETURN;
}
}
dPOPTOPiirl;
if (!right)
DIE(aTHX_ "Illegal modulus zero");
- SETi( left % PERL_ABS(right) );
+ /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
+ if (right == -1)
+ SETi( 0 );
+ else
+ SETi( left % PERL_ABS(right) );
RETURN;
}
}
}
}
#endif
- SETi( left % right );
+ /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
+ if (right == -1)
+ SETi( 0 );
+ else
+ SETi( left % right );
RETURN;
}
}
PP(pp_sin)
{
- dVAR; dSP; dTARGET; tryAMAGICun(sin);
- {
- const NV value = POPn;
- XPUSHn(Perl_sin(value));
- RETURN;
+ dVAR; dSP; dTARGET;
+ int amg_type = sin_amg;
+ const char *neg_report = NULL;
+ NV (*func)(NV) = Perl_sin;
+ const int op_type = PL_op->op_type;
+
+ switch (op_type) {
+ case OP_COS:
+ amg_type = cos_amg;
+ func = Perl_cos;
+ break;
+ case OP_EXP:
+ amg_type = exp_amg;
+ func = Perl_exp;
+ break;
+ case OP_LOG:
+ amg_type = log_amg;
+ func = Perl_log;
+ neg_report = "log";
+ break;
+ case OP_SQRT:
+ amg_type = sqrt_amg;
+ func = Perl_sqrt;
+ neg_report = "sqrt";
+ break;
}
-}
-PP(pp_cos)
-{
- dVAR; dSP; dTARGET; tryAMAGICun(cos);
+ tryAMAGICun_var(amg_type);
{
const NV value = POPn;
- XPUSHn(Perl_cos(value));
+ if (neg_report) {
+ if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) {
+ SET_NUMERIC_STANDARD();
+ DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
+ }
+ }
+ XPUSHn(func(value));
RETURN;
}
}
RETPUSHYES;
}
-PP(pp_exp)
-{
- dVAR; dSP; dTARGET; tryAMAGICun(exp);
- {
- NV value;
- value = POPn;
- value = Perl_exp(value);
- XPUSHn(value);
- RETURN;
- }
-}
-
-PP(pp_log)
-{
- dVAR; dSP; dTARGET; tryAMAGICun(log);
- {
- const NV value = POPn;
- if (value <= 0.0) {
- SET_NUMERIC_STANDARD();
- DIE(aTHX_ "Can't take log of %"NVgf, value);
- }
- XPUSHn(Perl_log(value));
- RETURN;
- }
-}
-
-PP(pp_sqrt)
-{
- dVAR; dSP; dTARGET; tryAMAGICun(sqrt);
- {
- const NV value = POPn;
- if (value < 0.0) {
- SET_NUMERIC_STANDARD();
- DIE(aTHX_ "Can't take sqrt of %"NVgf, value);
- }
- XPUSHn(Perl_sqrt(value));
- RETURN;
- }
-}
-
PP(pp_int)
{
dVAR; dSP; dTARGET; tryAMAGICun(int);
RETURN;
}
-
-PP(pp_hex)
-{
- dVAR; dSP; dTARGET;
- const char *tmps;
- I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
- STRLEN len;
- NV result_nv;
- UV result_uv;
- SV* const sv = POPs;
-
- tmps = (SvPV_const(sv, len));
- if (DO_UTF8(sv)) {
- /* If Unicode, try to downgrade
- * If not possible, croak. */
- SV* const tsv = sv_2mortal(newSVsv(sv));
-
- SvUTF8_on(tsv);
- sv_utf8_downgrade(tsv, FALSE);
- tmps = SvPV_const(tsv, len);
- }
- result_uv = grok_hex (tmps, &len, &flags, &result_nv);
- if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
- XPUSHn(result_nv);
- }
- else {
- XPUSHu(result_uv);
- }
- RETURN;
-}
-
PP(pp_oct)
{
dVAR; dSP; dTARGET;
sv_utf8_downgrade(tsv, FALSE);
tmps = SvPV_const(tsv, len);
}
+ if (PL_op->op_type == OP_HEX)
+ goto hex;
+
while (*tmps && len && isSPACE(*tmps))
tmps++, len--;
if (*tmps == '0')
tmps++, len--;
- if (*tmps == 'x')
+ if (*tmps == 'x') {
+ hex:
result_uv = grok_hex (tmps, &len, &flags, &result_nv);
+ }
else if (*tmps == 'b')
result_uv = grok_bin (tmps, &len, &flags, &result_nv);
else
I32 fail;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
const char *tmps;
- const I32 arybase = PL_curcop->cop_arybase;
+ const I32 arybase = CopARYBASE_get(PL_curcop);
SV *repl_sv = NULL;
const char *repl = NULL;
STRLEN repl_len;
Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
"Attempt to use reference as lvalue in substr");
}
- if (SvOK(sv)) /* is it defined ? */
+ if (isGV_with_GP(sv))
+ SvPV_force_nolen(sv);
+ else if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only_UTF8(sv);
else
sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
if (LvTARG(TARG) != sv) {
if (LvTARG(TARG))
SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc(sv);
+ LvTARG(TARG) = SvREFCNT_inc_simple(sv);
}
LvTARGOFF(TARG) = upos;
LvTARGLEN(TARG) = urem;
if (LvTARG(TARG) != src) {
if (LvTARG(TARG))
SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc(src);
+ LvTARG(TARG) = SvREFCNT_inc_simple(src);
}
LvTARGOFF(TARG) = offset;
LvTARGLEN(TARG) = size;
SV *big;
SV *little;
SV *temp = NULL;
+ STRLEN biglen;
+ STRLEN llen = 0;
I32 offset;
I32 retval;
const char *tmps;
const char *tmps2;
- STRLEN biglen;
- const I32 arybase = PL_curcop->cop_arybase;
- int big_utf8;
- int little_utf8;
-
- if (MAXARG < 3)
- offset = 0;
- else
+ const I32 arybase = CopARYBASE_get(PL_curcop);
+ bool big_utf8;
+ bool little_utf8;
+ const bool is_index = PL_op->op_type == OP_INDEX;
+
+ if (MAXARG >= 3) {
+ /* arybase is in characters, like offset, so combine prior to the
+ UTF-8 to bytes calculation. */
offset = POPi - arybase;
+ }
little = POPs;
big = POPs;
big_utf8 = DO_UTF8(big);
little_utf8 = DO_UTF8(little);
if (big_utf8 ^ little_utf8) {
/* One needs to be upgraded. */
- SV * const bytes = little_utf8 ? big : little;
- STRLEN len;
- const char * const p = SvPV_const(bytes, len);
-
- temp = newSVpvn(p, len);
+ if (little_utf8 && !PL_encoding) {
+ /* Well, maybe instead we might be able to downgrade the small
+ string? */
+ STRLEN little_len;
+ const U8 * const little_pv = (U8*) SvPV_const(little, little_len);
+ char * const pv = (char*)bytes_from_utf8(little_pv, &little_len,
+ &little_utf8);
+ if (little_utf8) {
+ /* If the large string is ISO-8859-1, and it's not possible to
+ convert the small string to ISO-8859-1, then there is no
+ way that it could be found anywhere by index. */
+ retval = -1;
+ goto fail;
+ }
- if (PL_encoding) {
- sv_recode_to_utf8(temp, PL_encoding);
+ /* At this point, pv is a malloc()ed string. So donate it to temp
+ to ensure it will get free()d */
+ little = temp = newSV(0);
+ sv_usepvn(temp, pv, little_len);
} else {
- sv_utf8_upgrade(temp);
- }
- if (little_utf8) {
- big = temp;
- big_utf8 = TRUE;
- } else {
- little = temp;
- }
- }
- if (big_utf8 && offset > 0)
- sv_pos_u2b(big, &offset, 0);
- tmps = SvPV_const(big, biglen);
- if (offset < 0)
- offset = 0;
- else if (offset > (I32)biglen)
- offset = biglen;
- if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
- (unsigned char*)tmps + biglen, little, 0)))
- retval = -1;
- else
- retval = tmps2 - tmps;
- if (retval > 0 && big_utf8)
- sv_pos_b2u(big, &retval);
- if (temp)
- SvREFCNT_dec(temp);
- PUSHi(retval + arybase);
- RETURN;
-}
-
-PP(pp_rindex)
-{
- dVAR; dSP; dTARGET;
- SV *big;
- SV *little;
- SV *temp = NULL;
- STRLEN blen;
- STRLEN llen;
- I32 offset;
- I32 retval;
- const char *tmps;
- const char *tmps2;
- const I32 arybase = PL_curcop->cop_arybase;
- int big_utf8;
- int little_utf8;
-
- if (MAXARG >= 3)
- offset = POPi;
- little = POPs;
- big = POPs;
- big_utf8 = DO_UTF8(big);
- little_utf8 = DO_UTF8(little);
- if (big_utf8 ^ little_utf8) {
- /* One needs to be upgraded. */
- SV * const bytes = little_utf8 ? big : little;
- STRLEN len;
- const char *p = SvPV_const(bytes, len);
+ SV * const bytes = little_utf8 ? big : little;
+ STRLEN len;
+ const char * const p = SvPV_const(bytes, len);
- temp = newSVpvn(p, len);
+ temp = newSVpvn(p, len);
- if (PL_encoding) {
- sv_recode_to_utf8(temp, PL_encoding);
- } else {
- sv_utf8_upgrade(temp);
- }
- if (little_utf8) {
- big = temp;
- big_utf8 = TRUE;
- } else {
- little = temp;
+ if (PL_encoding) {
+ sv_recode_to_utf8(temp, PL_encoding);
+ } else {
+ sv_utf8_upgrade(temp);
+ }
+ if (little_utf8) {
+ big = temp;
+ big_utf8 = TRUE;
+ } else {
+ little = temp;
+ }
}
}
- tmps2 = SvPV_const(little, llen);
- tmps = SvPV_const(big, blen);
+ /* Don't actually need the NULL initialisation, but it keeps gcc quiet. */
+ tmps2 = is_index ? NULL : SvPV_const(little, llen);
+ tmps = SvPV_const(big, biglen);
if (MAXARG < 3)
- offset = blen;
+ offset = is_index ? 0 : biglen;
else {
- if (offset > 0 && big_utf8)
+ if (big_utf8 && offset > 0)
sv_pos_u2b(big, &offset, 0);
- offset = offset - arybase + llen;
+ offset += llen;
}
if (offset < 0)
offset = 0;
- else if (offset > (I32)blen)
- offset = blen;
- if (!(tmps2 = rninstr(tmps, tmps + offset,
- tmps2, tmps2 + llen)))
+ else if (offset > (I32)biglen)
+ offset = biglen;
+ if (!(tmps2 = is_index
+ ? fbm_instr((unsigned char*)tmps + offset,
+ (unsigned char*)tmps + biglen, little, 0)
+ : rninstr(tmps, tmps + offset,
+ tmps2, tmps2 + llen)))
retval = -1;
- else
+ else {
retval = tmps2 - tmps;
- if (retval > 0 && big_utf8)
- sv_pos_b2u(big, &retval);
+ if (retval > 0 && big_utf8)
+ sv_pos_b2u(big, &retval);
+ }
if (temp)
SvREFCNT_dec(temp);
+ fail:
PUSHi(retval + arybase);
RETURN;
}
if (slen > ulen)
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
SvUTF8_on(TARG);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
s = (U8*)SvPV_force_nomg(sv, slen);
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
STRLEN min = len + 1;
*d = '\0';
SvUTF8_on(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
}
else {
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
STRLEN min = len + 1;
#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode U+03A3 */
if (uv == GREEK_CAPITAL_LETTER_SIGMA) {
+ /*EMPTY*/
/*
* Now if the sigma is NOT followed by
* /$ignorable_sequence$cased_letter/;
*d = '\0';
SvUTF8_on(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
}
else {
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
if (SvTYPE(av) == SVt_PVAV) {
- const I32 arybase = PL_curcop->cop_arybase;
+ const I32 arybase = CopARYBASE_get(PL_curcop);
if (lval && PL_op->op_private & OPpLVAL_INTRO) {
register SV **svp;
I32 max = -1;
DIE(aTHX_ PL_no_helem_sv, keysv);
}
if (localizing) {
- if (preeminent)
- save_helem(hv, keysv, svp);
- else {
- STRLEN keylen;
- const char *key = SvPV_const(keysv, keylen);
- SAVEDELETE(hv, savepvn(key,keylen), keylen);
- }
+ if (HvNAME_get(hv) && isGV(*svp))
+ save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
+ else {
+ if (preeminent)
+ save_helem(hv, keysv, svp);
+ else {
+ STRLEN keylen;
+ const char * const key = SvPV_const(keysv, keylen);
+ SAVEDELETE(hv, savepvn(key,keylen),
+ SvUTF8(keysv) ? -keylen : keylen);
+ }
+ }
}
}
*MARK = svp ? *svp : &PL_sv_undef;
SV ** const lastlelem = PL_stack_base + POPMARK;
SV ** const firstlelem = PL_stack_base + POPMARK + 1;
register SV ** const firstrelem = lastlelem + 1;
- const I32 arybase = PL_curcop->cop_arybase;
+ const I32 arybase = CopARYBASE_get(PL_curcop);
I32 is_something_there = PL_op->op_flags & OPf_MOD;
register const I32 max = lastrelem - lastlelem;
I32 newlen;
I32 after;
I32 diff;
- SV **tmparyval = NULL;
const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
if (mg) {
if (offset < 0)
offset += AvFILLp(ary) + 1;
else
- offset -= PL_curcop->cop_arybase;
+ offset -= CopARYBASE_get(PL_curcop);
if (offset < 0)
DIE(aTHX_ PL_no_aelem, i);
if (++MARK < SP) {
}
if (diff < 0) { /* shrinking the area */
+ SV **tmparyval;
if (newlen) {
Newx(tmparyval, newlen, SV*); /* so remember insertion */
Copy(MARK, tmparyval, newlen, SV*);
}
}
else { /* no, expanding (or same) */
+ SV** tmparyval = NULL;
if (length) {
Newx(tmparyval, length, SV*); /* so remember deletion */
Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
}
if (diff > 0) { /* expanding */
-
/* push up or down? */
-
if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
if (offset) {
src = AvARRAY(ary);
dst++;
}
}
- Safefree(tmparyval);
}
MARK += length - 1;
}
while (length-- > 0)
SvREFCNT_dec(tmparyval[length]);
}
- Safefree(tmparyval);
}
else
*MARK = &PL_sv_undef;
+ Safefree(tmparyval);
}
SP = MARK;
RETURN;
RETURN;
}
-PP(pp_pop)
-{
- dVAR;
- dSP;
- AV * const av = (AV*)POPs;
- SV * const sv = av_pop(av);
- if (AvREAL(av))
- (void)sv_2mortal(sv);
- PUSHs(sv);
- RETURN;
-}
-
PP(pp_shift)
{
dVAR;
dSP;
AV * const av = (AV*)POPs;
- SV * const sv = av_shift(av);
+ SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
EXTEND(SP, 1);
- if (!sv)
- RETPUSHUNDEF;
+ assert (sv);
if (AvREAL(av))
(void)sv_2mortal(sv);
PUSHs(sv);
register I32 tmp;
dTARGET;
STRLEN len;
- I32 padoff_du;
+ PADOFFSET padoff_du;
SvUTF8_off(TARG); /* decontaminate */
if (SP - MARK > 1)
sv_setsv(TARG, (SP > MARK)
? *SP
: (padoff_du = find_rundefsvoffset(),
- (padoff_du == NOT_IN_PAD || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR)
+ (padoff_du == NOT_IN_PAD
+ || PAD_COMPNAME_FLAGS_isOUR(padoff_du))
? DEFSV : PAD_SVl(padoff_du)));
up = SvPV_force(TARG, len);
if (len > 1) {
const I32 oldsave = PL_savestack_ix;
I32 make_mortal = 1;
bool multiline = 0;
- MAGIC *mg = (MAGIC *) NULL;
+ MAGIC *mg = NULL;
#ifdef DEBUGGING
Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
projects / p5sagit/p5-mst-13.2.git / blobdiff