}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ PL_no_symref_sv, sv, "a symbol");
+ DIE(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), "a symbol");
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
== OPpDONT_INIT_GV) {
/* We are the target of a coderef assignment. Return
if (PL_op->op_private & HINT_STRICT_REFS) {
if (SvOK(sv))
- Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+ Perl_die(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), what);
else
Perl_die(aTHX_ PL_no_usym, what);
}
{
dVAR; dSP;
AV * const av = MUTABLE_AV(TOPs);
- SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
- if (!*sv) {
- *sv = newSV_type(SVt_PVMG);
- sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+ const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ if (lvalue) {
+ SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
+ if (!*sv) {
+ *sv = newSV_type(SVt_PVMG);
+ sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+ }
+ SETs(*sv);
+ } else {
+ SETs(sv_2mortal(newSViv(
+ AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop)
+ )));
}
- SETs(*sv);
RETURN;
}
LvTYPE(TARG) = '.';
if (LvTARG(TARG) != sv) {
- if (LvTARG(TARG))
- SvREFCNT_dec(LvTARG(TARG));
+ SvREFCNT_dec(LvTARG(TARG));
LvTARG(TARG) = SvREFCNT_inc_simple(sv);
}
PUSHs(TARG); /* no SvSETMAGIC */
ret = newSVpvs_flags("_;$", SVs_TEMP);
goto set;
}
+ if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
+ ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+ goto set;
+ }
if (code == -KEY_readpipe) {
s = "CORE::backtick";
}
if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
Perl_croak(aTHX_ "Attempt to bless into a reference");
ptr = SvPV_const(ssv,len);
- if (len == 0 && ckWARN(WARN_MISC))
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Explicit blessing to '' (assuming package main)");
+ if (len == 0)
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+ "Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, GV_ADD);
}
hv_undef(MUTABLE_HV(sv));
break;
case SVt_PVCV:
- if (cv_const_sv((const CV *)sv) && ckWARN(WARN_MISC))
- Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
- CvANON((const CV *)sv) ? "(anonymous)"
- : GvENAME(CvGV((const CV *)sv)));
+ 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)));
/* FALLTHROUGH */
case SVt_PVFM:
{
if (fail < 0) {
if (lvalue || repl)
Perl_croak(aTHX_ "substr outside of string");
- if (ckWARN(WARN_SUBSTR))
- Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
+ Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
RETPUSHUNDEF;
}
else {
sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
if (repl_is_utf8)
SvUTF8_on(sv);
- if (repl_sv_copy)
- SvREFCNT_dec(repl_sv_copy);
+ SvREFCNT_dec(repl_sv_copy);
}
else if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
SvPV_force_nolen(sv);
- if (ckWARN(WARN_SUBSTR))
- Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
- "Attempt to use reference as lvalue in substr");
+ Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+ "Attempt to use reference as lvalue in substr");
}
if (isGV_with_GP(sv))
SvPV_force_nolen(sv);
LvTYPE(TARG) = 'x';
if (LvTARG(TARG) != sv) {
- if (LvTARG(TARG))
- SvREFCNT_dec(LvTARG(TARG));
+ SvREFCNT_dec(LvTARG(TARG));
LvTARG(TARG) = SvREFCNT_inc_simple(sv);
}
LvTARGOFF(TARG) = upos;
}
LvTYPE(TARG) = 'v';
if (LvTARG(TARG) != src) {
- if (LvTARG(TARG))
- SvREFCNT_dec(LvTARG(TARG));
+ SvREFCNT_dec(LvTARG(TARG));
LvTARG(TARG) = SvREFCNT_inc_simple(src);
}
LvTARGOFF(TARG) = offset;
if (retval > 0 && big_utf8)
sv_pos_b2u(big, &retval);
}
- if (temp)
- SvREFCNT_dec(temp);
+ SvREFCNT_dec(temp);
fail:
PUSHi(retval + arybase);
RETURN;
SV * const val = newSV(0);
if (MARK < SP)
sv_setsv(val, *++MARK);
- else if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
+ else
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
length = AvMAX(ary) + 1;
}
if (offset > AvFILLp(ary) + 1) {
- if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
offset = AvFILLp(ary) + 1;
}
after = AvFILLp(ary) + 1 - (offset + length);
call_method("PUSH",G_SCALAR|G_DISCARD);
LEAVE;
SPAGAIN;
- SP = ORIGMARK;
- if (GIMME_V != G_VOID) {
- PUSHi( AvFILL(ary) + 1 );
- }
}
else {
PL_delaymagic = DM_DELAY;
mg_set(MUTABLE_SV(ary));
PL_delaymagic = 0;
- SP = ORIGMARK;
- if (OP_GIMME(PL_op, 0) != G_VOID) {
- PUSHi( AvFILL(ary) + 1 );
- }
+ }
+ SP = ORIGMARK;
+ if (OP_GIMME(PL_op, 0) != G_VOID) {
+ PUSHi( AvFILL(ary) + 1 );
}
RETURN;
}
}
}
SP = ORIGMARK;
- if (GIMME_V != G_VOID) {
+ if (OP_GIMME(PL_op, 0) != G_VOID) {
PUSHi( AvFILL(ary) + 1 );
}
RETURN;
PP(pp_reverse)
{
dVAR; dSP; dMARK;
- SV ** const oldsp = SP;
if (GIMME == G_ARRAY) {
- MARK++;
- while (MARK < SP) {
- register SV * const tmp = *MARK;
- *MARK++ = *SP;
- *SP-- = tmp;
+ if (PL_op->op_private & OPpREVERSE_INPLACE) {
+ AV *av;
+
+ /* See pp_sort() */
+ assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
+ (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
+ av = MUTABLE_AV((*SP));
+ /* In-place reversing only happens in void context for the array
+ * assignment. We don't need to push anything on the stack. */
+ SP = MARK;
+
+ if (SvMAGICAL(av)) {
+ I32 i, j;
+ register SV *tmp = sv_newmortal();
+ /* For SvCANEXISTDELETE */
+ HV *stash;
+ const MAGIC *mg;
+ bool can_preserve = SvCANEXISTDELETE(av);
+
+ for (i = 0, j = av_len(av); i < j; ++i, --j) {
+ register SV *begin, *end;
+
+ if (can_preserve) {
+ if (!av_exists(av, i)) {
+ if (av_exists(av, j)) {
+ register SV *sv = av_delete(av, j, 0);
+ begin = *av_fetch(av, i, TRUE);
+ sv_setsv_mg(begin, sv);
+ }
+ continue;
+ }
+ else if (!av_exists(av, j)) {
+ register SV *sv = av_delete(av, i, 0);
+ end = *av_fetch(av, j, TRUE);
+ sv_setsv_mg(end, sv);
+ continue;
+ }
+ }
+
+ begin = *av_fetch(av, i, TRUE);
+ end = *av_fetch(av, j, TRUE);
+ sv_setsv(tmp, begin);
+ sv_setsv_mg(begin, end);
+ sv_setsv_mg(end, tmp);
+ }
+ }
+ else {
+ SV **begin = AvARRAY(av);
+ SV **end = begin + AvFILLp(av);
+
+ while (begin < end) {
+ register SV * const tmp = *begin;
+ *begin++ = *end;
+ *end-- = tmp;
+ }
+ }
+ }
+ else {
+ SV **oldsp = SP;
+ MARK++;
+ while (MARK < SP) {
+ register SV * const tmp = *MARK;
+ *MARK++ = *SP;
+ *SP-- = tmp;
+ }
+ /* safe as long as stack cannot get extended in the above */
+ SP = oldsp;
}
- /* safe as long as stack cannot get extended in the above */
- SP = oldsp;
}
else {
register char *up;
I32 realarray = 0;
I32 base;
const I32 gimme = GIMME_V;
- const bool gimme_scalar = (GIMME_V == G_SCALAR);
+ bool gimme_scalar;
const I32 oldsave = PL_savestack_ix;
U32 make_mortal = SVs_TEMP;
bool multiline = 0;
multiline = 1;
}
+ gimme_scalar = gimme == G_SCALAR && !ary;
+
if (!limit)
limit = maxiters + 2;
if (RX_EXTFLAGS(rx) & RXf_WHITE) {
dVAR;
DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
PL_op->op_type);
+ return NORMAL;
+}
+
+PP(pp_boolkeys)
+{
+ dVAR;
+ dSP;
+ HV * const hv = (HV*)POPs;
+
+ if (SvRMAGICAL(hv)) {
+ MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+ if (mg) {
+ XPUSHs(magic_scalarpack(hv, mg));
+ RETURN;
+ }
+ }
+
+ XPUSHs(boolSV(HvKEYS(hv) != 0));
+ RETURN;
}
/*
projects / p5sagit/p5-mst-13.2.git / blobdiff