From f6a1686942506c3f2a041ff124bdc34d22ed5f26 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 25 Aug 2011 12:43:54 -0700
Subject: [PATCH] &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:
---
 gv.c            |  1 -
 op.c            | 11 ++++++++++-
 t/op/coresubs.t | 15 +++++++++++++++
 3 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/gv.c b/gv.c
index da66c10..a9a1129 100644
--- 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
--- 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
--- 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;
-- 
2.7.4