$priv{$_}{2} = "GREPLEX"
for ("mapwhile", "mapstart", "grepwhile", "grepstart");
}
+$priv{$_}{128} = '+1' for qw "caller wantarray";
our %hints; # used to display each COP's op_hints values
case KEY_getlogin: case KEY_getnetent: case KEY_getppid:
case KEY_getprotoent: case KEY_getservent: case KEY_setgrent:
case KEY_setpwent: case KEY_time: case KEY_times:
- case KEY_wait:
+ case KEY_wait: case KEY_wantarray:
ampable = TRUE;
}
if (ampable) {
break;
}
default:
- o = op_append_elem(OP_LINESEQ, argop, newOP(opnum,0));
+ o = op_append_elem(OP_LINESEQ, argop,
+ newOP(opnum,
+ opnum == OP_WANTARRAY
+ ? OPpOFFBYONE << 8
+ : 0
+ )
+ );
}
newATTRSUB(oldsavestack_ix,
newSVOP(
/* Private for OP_ENTEREVAL */
#define OPpEVAL_HAS_HH 2 /* Does it have a copy of %^H */
+/* Private for OP_CALLER and OP_WANTARRAY */
+#define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */
+
struct op {
BASEOP
};
dVAR;
dSP;
I32 cxix;
+ const PERL_CONTEXT *cx;
EXTEND(SP, 1);
- cxix = dopoptosub(cxstack_ix);
- if (cxix < 0)
+ if (PL_op->op_private & OPpOFFBYONE) {
+ if (!(cx = caller_cx(1,NULL))) RETPUSHUNDEF;
+ }
+ else {
+ cxix = dopoptosub(cxstack_ix);
+ if (cxix < 0)
RETPUSHUNDEF;
+ cx = &cxstack[cxix];
+ }
- switch (cxstack[cxix].blk_gimme) {
+ switch (cx->blk_gimme) {
case G_ARRAY:
RETPUSHYES;
case G_SCALAR:
test_proto 'wait';
+test_proto 'wantarray';
+$tests += 4;
+my $context;
+my $cx_sub = sub {
+ $context = qw[void scalar list][&mywantarray + defined mywantarray()]
+};
+() = &$cx_sub;
+is $context, 'list', '&wantarray with caller in list context';
+scalar &$cx_sub;
+is($context, 'scalar', '&wantarray with caller in scalar context');
+&$cx_sub;
+is($context, 'void', '&wantarray with caller in void context');
+lis [&mywantarray],[wantarray], '&wantarray itself in list context';
+
# Add new tests above this line.