&CORE::foo() for dbmopen and dbmclose

This commit allows the subs in the CORE package for close, getc and
readline to be called through references and via ampersand syntax.  A
special case for each of them is added to pp_coreargs to deal with
calls with no arguments.  Pushing a null on to the stack (which I’m
doing for other ops) won’t work, as a null already means something for
these cases: close($f) won’t vivify a typeglob if $f is a string, so
the implicit rv2gv pushes a null on to the stack.

1 files changed, 32 insertions, 0 deletions

diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index a3c1eb3dec..9ed64ccbe7 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -136,6 +136,26 @@ sub test_proto {
     like $@, qr/^Not enough arguments for $desc at /,
        "&$o with too few args";
   }
+  elsif ($p =~ /^\\%\$*\z/) { #  \% and \%$$
+    $tests += 5;
+
+    eval "&CORE::$o(" . join(",", (1) x length $p) . ")";
+    like $@, qr/^Too many arguments for $o at /,
+         "&$o with too many args";
+    eval " &CORE::$o(" . join(",", (1) x (length($p)-2)) . ") ";
+    like $@, qr/^Not enough arguments for $o at /,
+         "&$o with too few args";
+    my $moreargs = ",1" x (length($p) - 2);
+    eval " &CORE::$o([]$moreargs) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
+        "&$o with array ref arg";
+    eval " &CORE::$o(*foo$moreargs) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
+        "&$o with typeglob arg";
+    eval " &CORE::$o(bless([], 'hov')$moreargs) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
+        "&$o with non-hash arg with hash overload (which does not count)";
+  }
 
   else {
     die "Please add tests for the $p prototype";
@@ -280,6 +300,18 @@ CORE::given(1) {
 test_proto 'cos';
 test_proto 'crypt';
 
+test_proto 'dbmclose';
+test_proto 'dbmopen';
+{
+  last unless eval { require AnyDBM_File };
+  $tests ++;
+  my $filename = tempfile();
+  &mydbmopen(\my %db, $filename, 0666);
+  $db{1} = 2; $db{3} = 4;
+  &mydbmclose(\%db);
+  is scalar keys %db, 0, '&dbmopen and &dbmclose';
+}
+
 test_proto 'die';
 eval { dier('quinquangle') };
 is $@, "quinquangle at frob line 6.\n", '&CORE::die'; $tests ++;