&CORE::open()

This commit allows &CORE::open to be called through references or with
ampersand syntax.  It modifies pp_coreargs not to push nulls for ops
that require a pushmark.

diff --git a/gv.c b/gv.c
index de205a1..ab47c56 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1356,7 +1356,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            case KEY_each: case KEY_eof: case KEY_exec:
            case KEY_keys:
            case KEY_lstat:
-           case KEY_open: case KEY_pop:
+           case KEY_pop:
            case KEY_push: case KEY_rand: case KEY_read:
            case KEY_recv: case KEY_reset:
            case KEY_select: case KEY_send:

diff --git a/pp.c b/pp.c
index fd17bc1..78b1271 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -6017,6 +6017,7 @@ PP(pp_coreargs)
     I32 oa = opnum ? PL_opargs[opnum] >> OASHIFT : 0;
     bool seen_question = 0;
     const char *err = NULL;
+    const bool pushmark = PL_op->op_private & OPpCOREARGS_PUSHMARK;
 
     /* Count how many args there are first, to get some idea how far to
        extend the stack. */
@@ -6049,7 +6050,7 @@ PP(pp_coreargs)
     /* We do this here, rather than with a separate pushmark op, as it has
        to come in between two things this function does (stack reset and
        arg pushing).  This seems the easiest way to do it. */
-    if (PL_op->op_private & OPpCOREARGS_PUSHMARK) {
+    if (pushmark) {
        PUTBACK;
        (void)Perl_pp_pushmark(aTHX);
     }
@@ -6072,7 +6073,7 @@ PP(pp_coreargs)
        );
        oa >>= 4;
     }
-    for (;oa;(void)(numargs&&(++svp,--numargs))) {
+    for (; oa&&(numargs||!pushmark); (void)(numargs&&(++svp,--numargs))) {
        whicharg++;
        switch (oa & 7) {
        case OA_SCALAR:

diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index d6efd16..dd32f87 100644 (file)
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -135,9 +135,11 @@ sub test_proto {
   elsif ($p eq '@') {
     # Do nothing, as we cannot test for too few or too many arguments.
   }
-  elsif ($p eq '$@') {
+  elsif ($p =~ '^[$*;]+@\z') {
     $tests ++;    
-    eval " &CORE::$o() ";
+    $p =~ ';@';
+    my $minargs = $-[0];
+    eval " &CORE::$o((1)x($minargs-1)) ";
     my $desc = quotemeta op_desc($o);
     like $@, qr/^Not enough arguments for $desc at /,
        "&$o with too few args";
@@ -458,6 +460,23 @@ is &mynot(1), !1, '&not';
 lis [&mynot(0)], [!0], '&not in list context';
 
 test_proto 'oct', '666', 438;
+
+test_proto 'open';
+$tests += 5;
+$file = 'test.pl';
+ok &myopen('file'), '&open with 1 arg' or warn "1-arg open: $!";
+like <file>, qr|^#|, 'result of &open with 1 arg';
+close file;
+{
+  ok &myopen(my $fh, "test.pl"), 'two-arg &open';
+  ok $fh, '&open autovivifies';
+  like <$fh>, qr '^#', 'result of &open with 2 args';
+  last if is_miniperl;
+  $tests +=2;
+  ok &myopen(my $fh2, "<", \"sharummbles"), 'retval of 3-arg &open';
+  is <$fh2>, 'sharummbles', 'result of three-arg &open';
+}
+
 test_proto 'opendir';
 test_proto 'ord', chr(64), 64;