OP* const retop = cx->blk_sub.retop;
SV **newsp;
I32 gimme;
- const SSize_t items = arg ? AvFILLp(arg) + 1 : 0;
+ const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
+ const bool m = arg ? SvRMAGICAL(arg) : 0;
SV** mark;
PERL_UNUSED_VAR(newsp);
/* put GvAV(defgv) back onto stack */
if (items) {
EXTEND(SP, items+1); /* @_ could have been extended. */
- Copy(AvARRAY(arg), SP + 1, items, SV*);
}
mark = SP;
- SP += items;
- if (items && AvREAL(arg)) {
+ if (items) {
SSize_t index;
+ bool r = cBOOL(AvREAL(arg));
for (index=0; index<items; index++)
- if (SP[-index])
- SvREFCNT_inc_void_NN(sv_2mortal(SP[-index]));
- else {
- SP[-index] = sv_2mortal(newSVavdefelem(arg,
- AvFILLp(arg) - index, 1));
+ {
+ SV *sv;
+ if (m) {
+ SV ** const svp = av_fetch(arg, index, 0);
+ sv = svp ? *svp : NULL;
}
+ else sv = AvARRAY(arg)[index];
+ SP[index+1] = sv
+ ? r ? SvREFCNT_inc_NN(sv_2mortal(sv)) : sv
+ : sv_2mortal(newSVavdefelem(arg, index, 1));
+ }
}
+ SP += items;
SvREFCNT_dec(arg);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
/* Restore old @_ */
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
AV * const av = GvAV(PL_defgv);
- const SSize_t items = AvFILLp(av) + 1; /* @_ is not tieable */
+ const SSize_t items = AvFILL(av) + 1;
if (items) {
SSize_t i = 0;
+ const bool m = cBOOL(SvRMAGICAL(av));
/* Mark is at the end of the stack. */
EXTEND(SP, items);
for (; i < items; ++i)
- if (AvARRAY(av)[i]) SP[i+1] = AvARRAY(av)[i];
+ {
+ SV *sv;
+ if (m) {
+ SV ** const svp = av_fetch(av, i, 0);
+ sv = svp ? *svp : NULL;
+ }
+ else sv = AvARRAY(av)[i];
+ if (sv) SP[i+1] = sv;
else {
SP[i+1] = newSVavdefelem(av, i, 1);
}
+ }
SP += items;
PUTBACK ;
}
EXPECT
main
ok
+########
+
+# &xsub and goto &xsub with tied @_
+use Tie::Array;
+tie @_, Tie::StdArray;
+@_ = "\xff";
+&utf8::encode;
+printf "%x\n", $_ for map ord, split //, $_[0];
+print "--\n";
+@_ = "\xff";
+& {sub { goto &utf8::encode }};
+printf "%x\n", $_ for map ord, split //, $_[0];
+EXPECT
+c3
+bf
+--
+c3
+bf