}
}
else {
- Copy(AvARRAY((const AV *)TARG), SP+1, maxarg, SV*);
+ PADOFFSET i;
+ for (i=0; i < (PADOFFSET)maxarg; i++) {
+ SV * const sv = AvARRAY((const AV *)TARG)[i];
+ SP[i+1] = sv ? sv : &PL_sv_undef;
+ }
}
SP += maxarg;
}
if (mg && mg->mg_len != -1) {
dTARGET;
STRLEN i = mg->mg_len;
- if (DO_UTF8(sv))
+ if (mg->mg_flags & MGf_BYTES && DO_UTF8(sv))
i = sv_pos_b2u_flags(sv, i, SV_GMAGIC|SV_CONST_RETURN);
PUSHu(i);
RETURN;
const char * s = SvPVX_const(TOPs);
if (strnEQ(s, "CORE::", 6)) {
const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
- if (!code || code == -KEY_CORE)
+ if (!code)
DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"",
UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6));
{
const char *ptr;
if (!ssv) goto curstash;
- if (!SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+ SvGETMAGIC(ssv);
+ if (SvROK(ssv)) {
+ if (!SvAMAGIC(ssv)) {
+ frog:
Perl_croak(aTHX_ "Attempt to bless into a reference");
- ptr = SvPV_const(ssv,len);
+ }
+ /* SvAMAGIC is on here, but it only means potentially overloaded,
+ so after stringification: */
+ ptr = SvPV_nomg_const(ssv,len);
+ /* We need to check the flag again: */
+ if (!SvAMAGIC(ssv)) goto frog;
+ }
+ else ptr = SvPV_nomg_const(ssv,len);
if (len == 0)
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Explicit blessing to '' (assuming package main)");
gp_free(MUTABLE_GV(sv));
Newxz(gp, 1, GP);
GvGP_set(sv, gp_ref(gp));
+#ifndef PERL_DONT_CREATE_GVSV
GvSV(sv) = newSV(0);
+#endif
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = MUTABLE_GV(sv);
GvMULTI_on(sv);
--Jarkko Hietaniemi 27 September 1998
*/
-#ifndef HAS_DRAND48_PROTO
-extern double drand48 (void);
-#endif
-
PP(pp_rand)
{
dVAR;
argsv = tmpsv;
}
- XPUSHu(DO_UTF8(argsv) ?
- utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV) :
- (UV)(*s & 0xff));
+ XPUSHu(DO_UTF8(argsv)
+ ? utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV)
+ : (UV)(*s & 0xff));
RETURN;
}
/* In locale, we quote all non-ASCII Latin1 chars.
* Otherwise use the quoting rules */
if (IN_LOCALE_RUNTIME
- || _isQUOTEMETA(TWO_BYTE_UTF8_TO_UNI(*s, *(s + 1))))
+ || _isQUOTEMETA(TWO_BYTE_UTF8_TO_NATIVE(*s, *(s + 1))))
{
to_quote = TRUE;
}
for (; s < send; s++) {
STRLEN ulen;
UV fc = _to_uni_fold_flags(*s, tmpbuf, &ulen, flags);
- if UNI_IS_INVARIANT(fc) {
+ if UVCHR_IS_INVARIANT(fc) {
if (full_folding
&& *s == LATIN_SMALL_LETTER_SHARP_S)
{
RETURN;
}
+PP(pp_kvaslice)
+{
+ dVAR; dSP; dMARK;
+ AV *const av = MUTABLE_AV(POPs);
+ I32 lval = (PL_op->op_flags & OPf_MOD);
+ SSize_t items = SP - MARK;
+
+ if (PL_op->op_private & OPpMAYBE_LVSUB) {
+ const I32 flags = is_lvalue_sub();
+ if (flags) {
+ if (!(flags & OPpENTERSUB_INARGS))
+ /* diag_listed_as: Can't modify %s in %s */
+ Perl_croak(aTHX_ "Can't modify index/value array slice in list assignment");
+ lval = flags;
+ }
+ }
+
+ MEXTEND(SP,items);
+ while (items > 1) {
+ *(MARK+items*2-1) = *(MARK+items);
+ items--;
+ }
+ items = SP-MARK;
+ SP += items;
+
+ while (++MARK <= SP) {
+ SV **svp;
+
+ svp = av_fetch(av, SvIV(*MARK), lval);
+ if (lval) {
+ if (!svp || !*svp || *svp == &PL_sv_undef) {
+ DIE(aTHX_ PL_no_aelem, SvIV(*MARK));
+ }
+ *MARK = sv_mortalcopy(*MARK);
+ }
+ *++MARK = svp ? *svp : &PL_sv_undef;
+ }
+ if (GIMME != G_ARRAY) {
+ MARK = SP - items*2;
+ *++MARK = items > 0 ? *SP : &PL_sv_undef;
+ SP = MARK;
+ }
+ RETURN;
+}
+
/* Smart dereferencing for keys, values and each */
PP(pp_rkeys)
{
RETURN;
}
+PP(pp_kvhslice)
+{
+ dVAR; dSP; dMARK;
+ HV * const hv = MUTABLE_HV(POPs);
+ I32 lval = (PL_op->op_flags & OPf_MOD);
+ SSize_t items = SP - MARK;
+
+ if (PL_op->op_private & OPpMAYBE_LVSUB) {
+ const I32 flags = is_lvalue_sub();
+ if (flags) {
+ if (!(flags & OPpENTERSUB_INARGS))
+ /* diag_listed_as: Can't modify %s in %s */
+ Perl_croak(aTHX_ "Can't modify key/value hash slice in list assignment");
+ lval = flags;
+ }
+ }
+
+ MEXTEND(SP,items);
+ while (items > 1) {
+ *(MARK+items*2-1) = *(MARK+items);
+ items--;
+ }
+ items = SP-MARK;
+ SP += items;
+
+ while (++MARK <= SP) {
+ SV * const keysv = *MARK;
+ SV **svp;
+ HE *he;
+
+ he = hv_fetch_ent(hv, keysv, lval, 0);
+ svp = he ? &HeVAL(he) : NULL;
+
+ if (lval) {
+ if (!svp || !*svp || *svp == &PL_sv_undef) {
+ DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+ }
+ *MARK = sv_mortalcopy(*MARK);
+ }
+ *++MARK = svp && *svp ? *svp : &PL_sv_undef;
+ }
+ if (GIMME != G_ARRAY) {
+ MARK = SP - items*2;
+ *++MARK = items > 0 ? *SP : &PL_sv_undef;
+ SP = MARK;
+ }
+ RETURN;
+}
+
/* List operators. */
PP(pp_list)
MARK = ORIGMARK + 1;
if (GIMME == G_ARRAY) { /* copy return vals to stack */
+ const bool real = cBOOL(AvREAL(ary));
MEXTEND(MARK, length);
- Copy(AvARRAY(ary)+offset, MARK, length, SV*);
- if (AvREAL(ary)) {
+ if (real)
EXTEND_MORTAL(length);
- for (i = length, dst = MARK; i; i--) {
+ for (i = 0, dst = MARK; i < length; i++) {
+ if ((*dst = AvARRAY(ary)[i+offset])) {
+ if (real)
sv_2mortal(*dst); /* free them eventually */
- dst++;
}
+ else
+ *dst = &PL_sv_undef;
+ dst++;
}
MARK += length - 1;
}
MARK = ORIGMARK + 1;
if (GIMME == G_ARRAY) { /* copy return vals to stack */
if (length) {
- Copy(tmparyval, MARK, length, SV*);
- if (AvREAL(ary)) {
+ const bool real = cBOOL(AvREAL(ary));
+ if (real)
EXTEND_MORTAL(length);
- for (i = length, dst = MARK; i; i--) {
+ for (i = 0, dst = MARK; i < length; i++) {
+ if ((*dst = tmparyval[i])) {
+ if (real)
sv_2mortal(*dst); /* free them eventually */
- dst++;
}
+ else *dst = &PL_sv_undef;
+ dst++;
}
}
MARK += length - 1;
const bool constr = PL_op->op_private & whicharg;
PUSHs(S_rv2gv(aTHX_
svp && *svp ? *svp : &PL_sv_undef,
- constr, CopHINTS_get(PL_curcop) & HINT_STRICT_REFS,
+ constr, cBOOL(CopHINTS_get(PL_curcop) & HINT_STRICT_REFS),
!constr
));
}
https://perl5.git.perl.org / perl5.git / blobdiff