diff options
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | pp.c | 5 | ||||
| -rw-r--r-- | t/op/coresubs.t | 23 |
3 files changed, 25 insertions, 5 deletions
@@ -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: @@ -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 d6efd16c7e..dd32f87fce 100644 --- 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, '¬'; lis [&mynot(0)], [!0], '¬ 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; |