diff options
| -rw-r--r-- | gv.c | 1 | ||||
| -rw-r--r-- | op.c | 11 | ||||
| -rw-r--r-- | t/op/coresubs.t | 15 |
3 files changed, 25 insertions, 2 deletions
@@ -1351,7 +1351,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne: case KEY_or: case KEY_x: case KEY_xor: return gv; - case KEY_binmode: case KEY_bless: case KEY_caller: case KEY_chdir: case KEY_chmod: case KEY_chomp: case KEY_chop: case KEY_chown: case KEY_close: @@ -7685,7 +7685,16 @@ Perl_ck_fun(pTHX_ OP *o) tokid = &kid->op_sibling; kid = kid->op_sibling; } - if (kid && kid->op_type == OP_COREARGS) return o; + if (kid && kid->op_type == OP_COREARGS) { + bool optional = FALSE; + while (oa) { + numargs++; + if (oa & OA_OPTIONAL) optional = TRUE; + oa = oa >> 4; + } + if (optional) o->op_private |= numargs; + return o; + } while (oa) { if (oa & OA_OPTIONAL || (oa & 7) == OA_LIST) { diff --git a/t/op/coresubs.t b/t/op/coresubs.t index 1bbd56ab67..9573e1fbf6 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -107,6 +107,15 @@ sub test_proto { eval " &CORE::$o((1)x($args+1)) "; like $@, qr/^Too many arguments for $o at /, "&$o with too many args"; } + elsif ($p =~ '^([$*]+);([$*]+)\z') { # Variable-length $$$ or *** + my $minargs = length $1; + my $maxargs = $minargs + length $2; + $tests += 2; + eval " &CORE::$o((1)x($minargs-1)) "; + like $@, qr/^Not enough arguments for $o at /, "&$o with too few args"; + eval " &CORE::$o((1)x($maxargs+1)) "; + like $@, qr/^Too many arguments for $o at /, "&$o with too many args"; + } else { die "Please add tests for the $p prototype"; @@ -150,6 +159,12 @@ eval { &mybind(my $foo, "bear") }; like $@, qr/^Bad symbol for filehandle at/, 'CORE::bind dies with undef first arg'; +test_proto 'binmode'; +$tests += 3; +is &CORE::binmode(qw[foo bar]), undef, "&binmode"; +lis [&CORE::binmode(qw[foo bar])], [undef], "&binmode in list context"; +is &mybinmode(foo), undef, '&binmode with one arg'; + test_proto 'break'; { $tests ++; my $tmp; |