&CORE::binmode()

This commit allows &CORE::binmode to be called through references and
via ampersand syntax.

Usually, an op that has optional arguments has the number of arguments
indicated with flags on the op itself:

diff --git a/gv.c b/gv.c
index da66c10..a9a1129 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -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:

diff --git a/op.c b/op.c
index 606e086..02811c6 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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 1bbd56a..9573e1f 100644 (file)
--- 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;