Allow &CORE::foo() with hash functions

&CORE::keys does not yet work as an lvalue.  (I’m not sure how to make
that work.)

doop.c

@@ -1241,8 +1241,12 @@ Perl_do_kv(pTHX)
     const U8 gimme = GIMME_V;
     const I32 dokv =     (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
     /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
-    const I32 dokeys =   dokv || (PL_op->op_type == OP_KEYS);
-    const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES);
+    const I32 dokeys =   dokv || (PL_op->op_type == OP_KEYS)
+	|| (  PL_op->op_type == OP_AVHVSWITCH
+	   && PL_op->op_private + OP_EACH == OP_KEYS  );
+    const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES)
+	|| (  PL_op->op_type == OP_AVHVSWITCH
+	   && PL_op->op_private + OP_EACH == OP_VALUES  );
 
     (void)hv_iterinit(keys);	/* always reset iterator regardless */
 

gv.c

@@ -531,8 +531,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
 	return NULL;
     case KEY_chdir:
     case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete:
-    case KEY_each : case KEY_eof : case KEY_exec   : case KEY_exists:
-    case KEY_keys:
+    case KEY_eof  : case KEY_exec: case KEY_exists :
     case KEY_lstat:
     case KEY_pop:
     case KEY_push:
@@ -542,7 +541,6 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     case KEY_system:
     case KEY_truncate: case KEY_unlink:
     case KEY_unshift:
-    case KEY_values:
 	ampable = FALSE;
     }
     if (!gv) {

op.c

@@ -14689,6 +14689,12 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
 	                          newOP(OP_CALLER,0)
 	               )
 	       );
+    case OP_EACH:
+    case OP_KEYS:
+    case OP_VALUES:
+	o = newUNOP(OP_AVHVSWITCH,0,argop);
+	o->op_private = opnum-OP_EACH;
+	return o;
     case OP_SELECT: /* which represents OP_SSELECT as well */
 	if (code)
 	    return newCONDOP(

pp.c

@@ -4845,7 +4845,10 @@ PP(pp_akeys)
 
         EXTEND(SP, n + 1);
 
-	if (PL_op->op_type == OP_AKEYS) {
+	if (  PL_op->op_type == OP_AKEYS
+	   || (  PL_op->op_type == OP_AVHVSWITCH
+	      && PL_op->op_private + OP_AEACH == OP_AKEYS  ))
+	{
 	    for (i = 0;  i <= n;  i++) {
 		mPUSHi(i);
 	    }
@@ -6310,11 +6313,16 @@ PP(pp_coreargs)
 	    RETURN;
 	case OA_HVREF:
 	    if (!svp || !*svp || !SvROK(*svp)
-	     || SvTYPE(SvRV(*svp)) != SVt_PVHV)
+	     || (  SvTYPE(SvRV(*svp)) != SVt_PVHV
+		&& (  opnum == OP_DBMCLOSE || opnum == OP_DBMOPEN
+		   || SvTYPE(SvRV(*svp)) != SVt_PVAV  )))
 		DIE(aTHX_
 		/* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/
-		 "Type of arg %d to &CORE::%s must be hash reference",
-		  whicharg, PL_op_desc[opnum]
+		 "Type of arg %d to &CORE::%s must be hash%s reference",
+		  whicharg, PL_op_desc[opnum],
+		  opnum == OP_DBMCLOSE || opnum == OP_DBMOPEN
+		     ? ""
+		     : " or array"
 		);
 	    PUSHs(SvRV(*svp));
 	    break;
@@ -6383,7 +6391,10 @@ PP(pp_coreargs)
 PP(pp_avhvswitch)
 {
     dSP;
-    RETURN;
+    return PL_ppaddr[
+		(SvTYPE(TOPs) == SVt_PVAV ? OP_AEACH : OP_EACH)
+		    + PL_op->op_private
+	   ](aTHX);
 }
 
 PP(pp_runcv)

regen/op_private

@@ -198,7 +198,7 @@ use strict;
 
     # find which ops use 0,1,2,3 or 4 bits of op_private for arg count info
 
-    $args0{$_} = 1 for qw(entersub); # UNOPs that usurp bit 0
+    $args0{$_} = 1 for qw(entersub avhvswitch); # UNOPs that usurp bit 0
 
     $args1{$_} = 1 for (
                         qw(reverse), # ck_fun(), but most bits stolen
@@ -758,6 +758,10 @@ addbits('multideref',
     5 => qw(OPpMULTIDEREF_DELETE DELETE), # deref is actually delete
 );
 
+
+
+addbits('avhvswitch', '0..1' => { });
+
 1;
 
 # ex: set ts=8 sts=4 sw=4 et:

t/op/coreamp.t

@@ -205,6 +205,38 @@ sub test_proto {
         "&$o with coderef arg";
     }    
   }
+  elsif ($p eq '\[%@]') {
+    $tests += 7;
+
+    eval " &CORE::$o(\\%1,2) ";
+    like $@, qr/^Too many arguments for ${\op_desc($o)} at /,
+        "&$o with too many args";
+    eval { &{"CORE::$o"}() };
+    like $@, qr/^Not enough arguments for $o at /,
+         "&$o with too few args";
+    eval " &CORE::$o(2) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x:
+                )reference at /,
+        "&$o with non-ref arg";
+    eval " &CORE::$o(*STDOUT{IO}) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x:
+                )reference at /,
+        "&$o with ioref arg";
+    my $class = ref *DATA{IO};
+    eval " &CORE::$o(bless(*DATA{IO}, 'hov')) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x:
+                )reference at /,
+        "&$o with ioref arg with hash overload (which does not count)";
+    bless *DATA{IO}, $class;
+    eval " &CORE::$o(\\&scriggle) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x:
+                )reference at /,
+        "&$o with coderef arg";
+    eval " &CORE::$o(\\\$_) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x:
+                )reference at /,
+        "&$o with scalarref arg";
+  }
   elsif ($p eq ';\[$*]') {
     $tests += 4;
 
@@ -468,6 +500,13 @@ is &myformline(' @<<< @>>>', 1, 2), 1, '&myformline retval';
 is $^A,        ' 1       2', 'effect of &myformline';
 lis [&myformline('@')], [1], '&myformline in list context';
 
+test_proto 'each';
+$tests += 4;
+is &myeach({ "a","b" }), "a", '&myeach(\%hash) in scalar cx';
+lis [&myeach({qw<a b>})], [qw<a b>], '&myeach(\%hash) in list cx';
+is &myeach([ "a","b" ]), 0, '&myeach(\@array) in scalar cx';
+lis [&myeach([qw<a b>])], [qw<0 a>], '&myeach(\@array) in list cx';
+
 test_proto 'exp';
 
 test_proto 'fc';
@@ -549,6 +588,13 @@ $tests += 2;
 is &myjoin('a','b','c'), 'bac', '&join';
 lis [&myjoin('a','b','c')], ['bac'], '&join in list context';
 
+test_proto 'keys';
+$tests += 4;
+is &mykeys({ 1..4 }), 2, '&mykeys(\%hash) in scalar cx';
+lis [sort &mykeys({1..4})], [1,3], '&mykeys(\%hash) in list cx';
+is &mykeys([ 1..4 ]), 4, '&mykeys(\@array) in scalar cx';
+lis [&mykeys([ 1..4 ])], [0..3], '&mykeys(\@array) in list cx';
+
 test_proto 'kill'; # set up mykill alias
 if ($^O ne 'riscos') {
     $tests ++;
@@ -943,6 +989,13 @@ $tests += 2;
 is &myutime(undef,undef), 0, '&utime';
 lis [&myutime(undef,undef)], [0], '&utime in list context';
 
+test_proto 'values';
+$tests += 4;
+is &myvalues({ 1..4 }), 2, '&myvalues(\%hash) in scalar cx';
+lis [sort &myvalues({1..4})], [2,4], '&myvalues(\%hash) in list cx';
+is &myvalues([ 1..4 ]), 4, '&myvalues(\@array) in scalar cx';
+lis [&myvalues([ 1..4 ])], [1..4], '&mykeys(\@array) in list cx';
+
 test_proto 'vec';
 $tests += 3;
 is &myvec("foo", 0, 4), 6, '&vec';