case KEY_chomp: case KEY_chop:
case KEY_each: case KEY_eof: case KEY_exec:
case KEY_keys:
- case KEY_lock: case KEY_lstat:
+ case KEY_lstat:
case KEY_mkdir: case KEY_open: case KEY_pop:
case KEY_push: case KEY_rand: case KEY_read:
case KEY_recv: case KEY_reset:
new ATTRSUB. */
(void)core_prototype((SV *)cv, name, code, &opnum);
if (ampable) {
- if (opnum == OP_VEC) CvLVALUE_on(cv);
+ if (opnum == OP_VEC || opnum == OP_LOCK) CvLVALUE_on(cv);
newATTRSUB(oldsavestack_ix,
newSVOP(
OP_CONST, 0,
)
);
assert(GvCV(gv) == cv);
+ if (opnum == OP_LOCK)
+ CvLVALUE_off(cv); /* Now *that* was a neat trick. */
LEAVE;
PL_parser = oldparser;
PL_curcop = oldcurcop;
));
}
break;
+ case OA_SCALARREF:
+ if (!svp || !*svp || !SvROK(*svp)
+ || SvTYPE(SvRV(*svp)) > SVt_PVCV
+ )
+ DIE(aTHX_
+ /* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/
+ "Type of arg %d to &CORE::%s must be reference to one of "
+ "[$@%%&*]",
+ whicharg, OP_DESC(PL_op->op_next)
+ );
+ PUSHs(SvRV(*svp));
+ break;
default:
DIE(aTHX_ "panic: unknown OA_*: %x", (unsigned)(oa&7));
}
like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
"&$o with non-hash arg with hash overload (which does not count)";
}
+ elsif ($p eq '\[$@%&*]') {
+ $tests += 5;
+
+ eval " &CORE::$o(1,2) ";
+ like $@, qr/^Too many arguments for $o at /,
+ "&$o with too many args";
+ eval " &CORE::$o() ";
+ like $@, qr/^Not enough arguments for $o at /,
+ "&$o with too few args";
+ eval " &CORE::$o(2) ";
+ like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
+ ) \[\$\@%&\*] at /,
+ "&$o with non-ref arg";
+ eval " &CORE::$o(*STDOUT{IO}) ";
+ like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
+ ) \[\$\@%&\*] at /,
+ "&$o with ioref arg";
+ my $class = ref *DATA{IO};
+ eval " &CORE::$o(bless(*DATA{IO}, 'hov')) ";
+ like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
+ ) \[\$\@%&\*] at /,
+ "&$o with ioref arg with hash overload (which does not count)";
+ bless *DATA{IO}, $class;
+ }
else {
die "Please add tests for the $p prototype";
&CORE::localtime;
pass '&localtime without args does not crash'; ++$tests;
+test_proto 'lock';
+$tests += 6;
+is \&mylock(\$foo), \$foo, '&lock retval when passed a scalar ref';
+lis [\&mylock(\$foo)], [\$foo], '&lock in list context';
+is &mylock(\@foo), \@foo, '&lock retval when passed an array ref';
+is &mylock(\%foo), \%foo, '&lock retval when passed a ash ref';
+is &mylock(\&foo), \&foo, '&lock retval when passed a code ref';
+is \&mylock(\*foo), \*foo, '&lock retval when passed a glob ref';
+
test_proto 'log';
test_proto "msg$_" for qw( ctl get rcv snd );