[Merge] More coresubs

Until now, only overridable keywords had subs in the CORE:: namespace.

This branch adds subs to the CORE:: namespace for those non-overrida-
ble keywords that can be implemented without custom parsers.

11 files changed, 236 insertions, 74 deletions

diff --git a/gv.c b/gv.c
index f75b76a4f6..0bfab3f310 100644
--- a/gv.c
+++ b/gv.c
@@ -452,25 +452,38 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     assert(gv || stash);
     assert(name);
 
-    if (code >= 0) return NULL; /* not overridable */
-    switch (-code) {
+    if (!code) return NULL; /* Not a keyword */
+    switch (code < 0 ? -code : code) {
      /* no support for \&CORE::infix;
-        no support for funcs that take labels, as their parsing is
-        weird  */
-    case KEY_and: case KEY_cmp: case KEY_CORE: case KEY_dump:
-    case KEY_eq: case KEY_ge:
-    case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne:
-    case KEY_or: case KEY_x: case KEY_xor:
+        no support for funcs that do not parse like funcs */
+    case KEY___DATA__: case KEY___END__: case KEY_and: case KEY_AUTOLOAD:
+    case KEY_BEGIN   : case KEY_CHECK  : case KEY_cmp: case KEY_CORE    :
+    case KEY_default : case KEY_DESTROY:
+    case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
+    case KEY_END     : case KEY_eq     : case KEY_eval  :
+    case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :
+    case KEY_given   : case KEY_goto   : case KEY_grep  :
+    case KEY_gt   : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le:
+    case KEY_local: case KEY_lt: case KEY_m   : case KEY_map : case KEY_my:
+    case KEY_ne   : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
+    case KEY_package: case KEY_print: case KEY_printf:
+    case KEY_q    : case KEY_qq   : case KEY_qr     : case KEY_qw    :
+    case KEY_qx   : case KEY_redo : case KEY_require: case KEY_return:
+    case KEY_s    : case KEY_say  : case KEY_sort   :
+    case KEY_state: case KEY_sub  :
+    case KEY_tr   : case KEY_UNITCHECK: case KEY_unless:
+    case KEY_until: case KEY_use  : case KEY_when     : case KEY_while :
+    case KEY_x    : case KEY_xor  : case KEY_y        :
 	return NULL;
     case KEY_chdir:
-    case KEY_chomp: case KEY_chop:
-    case KEY_each: case KEY_eof: case KEY_exec:
+    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_lstat:
     case KEY_pop:
     case KEY_push:
     case KEY_shift:
-    case KEY_splice:
+    case KEY_splice: case KEY_split:
     case KEY_stat:
     case KEY_system:
     case KEY_truncate: case KEY_unlink:
@@ -529,7 +542,8 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
 	           1
 	);
 	assert(GvCV(gv) == cv);
-	if (opnum != OP_VEC && opnum != OP_SUBSTR)
+	if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
+	 && opnum != OP_UNDEF)
 	    CvLVALUE_off(cv); /* Now *that* was a neat trick. */
 	LEAVE;
 	PL_parser = oldparser;
diff --git a/lib/CORE.pod b/lib/CORE.pod
index fc356e870f..ce5feb5908 100644
--- a/lib/CORE.pod
+++ b/lib/CORE.pod
@@ -34,14 +34,24 @@ For many Perl functions, the CORE package contains real subroutines.  This
 feature is new in Perl 5.16.  You can take references to these and make
 aliases.  However, some can only be called as barewords; i.e., you cannot
 use ampersand syntax (C<&foo>) or call them through references.  See the
-C<shove> example above.  These subroutines exist for all overridable
-keywords, except for C<dump> and the infix operators.  Calling with
+C<shove> example above.  These subroutines exist for all keywords except the following:
+
+C<__DATA__>, C<__END__>, C<and>, C<cmp>, C<default>, C<do>, C<dump>,
+C<else>, C<elsif>, C<eq>, C<eval>, C<for>, C<foreach>, C<format>, C<ge>,
+C<given>, C<goto>, C<grep>, C<gt>, C<if>, C<last>, C<le>, C<local>, C<lt>,
+C<m>, C<map>, C<my>, C<ne>, C<next>, C<no>, C<or>, C<our>, C<package>,
+C<print>, C<printf>, C<q>, C<qq>, C<qr>, C<qw>, C<qx>, C<redo>, C<require>,
+C<return>, C<s>, C<say>, C<sort>, C<state>, C<sub>, C<tr>, C<unless>,
+C<until>, C<use>, C<when>, C<while>, C<x>, C<xor>, C<y>
+
+Calling with
 ampersand syntax and through references does not work for the following
 functions, as they have special syntax that cannot always be translated
 into a simple list (e.g., C<eof> vs C<eof()>):
 
-C<chdir>, C<chomp>, C<chop>, C<each>, C<eof>, C<exec>, C<keys>, C<lstat>,
-C<pop>, C<push>, C<shift>, C<splice>, C<stat>, C<system>, C<truncate>,
+C<chdir>, C<chomp>, C<chop>, C<defined>, C<delete>, C<each>,
+C<eof>, C<exec>, C<exists>, C<keys>, C<lstat>, C<pop>, C<push>,
+C<shift>, C<splice>, C<split>, C<stat>, C<system>, C<truncate>,
 C<unlink>, C<unshift>, C<values>
 
 =head1 OVERRIDING CORE FUNCTIONS
diff --git a/op.c b/op.c
index 94b9281f87..697769cf34 100644
--- a/op.c
+++ b/op.c
@@ -2022,6 +2022,9 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 	if (type != OP_LEAVESUBLV)
 	    goto nomod;
 	break; /* op_lvalue()ing was handled by ck_return() */
+
+    case OP_COREARGS:
+	return o;
     }
 
     /* [20011101.069] File test operators interpret OPf_REF to mean that
@@ -2062,8 +2065,7 @@ S_scalar_mod_type(const OP *o, I32 type)
     switch (type) {
     case OP_POS:
     case OP_SASSIGN:
-	assert(o);
-	if (o->op_type == OP_RV2GV)
+	if (o && o->op_type == OP_RV2GV)
 	    return FALSE;
 	/* FALL THROUGH */
     case OP_PREINC:
@@ -8088,6 +8090,10 @@ Perl_ck_fun(pTHX_ OP *o)
 		scalar(kid);
 		break;
 	    case OA_SCALARREF:
+		if ((type == OP_UNDEF || type == OP_POS)
+		    && numargs == 1 && !(oa >> 4)
+		    && kid->op_type == OP_LIST)
+		    return too_many_arguments_pv(o,PL_op_desc[type], 0);
 		op_lvalue(scalar(kid), type);
 		break;
 	    }
@@ -10527,7 +10533,7 @@ Perl_custom_op_register(pTHX_ Perl_ppaddr_t ppaddr, const XOP *xop)
 This function assigns the prototype of the named core function to C<sv>, or
 to a new mortal SV if C<sv> is NULL.  It returns the modified C<sv>, or
 NULL if the core function has no prototype.  C<code> is a code as returned
-by C<keyword()>.  It must be negative and unequal to -KEY_CORE.
+by C<keyword()>.  It must not be equal to 0 or -KEY_CORE.
 
 =cut
 */
@@ -10544,19 +10550,24 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
 
     PERL_ARGS_ASSERT_CORE_PROTOTYPE;
 
-    assert (code < 0 && code != -KEY_CORE);
+    assert (code && code != -KEY_CORE);
 
     if (!sv) sv = sv_newmortal();
 
 #define retsetpvs(x,y) sv_setpvs(sv, x); if(opnum) *opnum=(y); return sv
 
-    switch (-code) {
+    switch (code < 0 ? -code : code) {
     case KEY_and   : case KEY_chop: case KEY_chomp:
-    case KEY_cmp   : case KEY_exec: case KEY_eq   :
-    case KEY_ge    : case KEY_gt  : case KEY_le   :
-    case KEY_lt    : case KEY_ne  : case KEY_or   :
-    case KEY_select: case KEY_system: case KEY_x  : case KEY_xor:
+    case KEY_cmp   : case KEY_defined: case KEY_delete: case KEY_exec  :
+    case KEY_exists: case KEY_eq     : case KEY_ge    : case KEY_goto  :
+    case KEY_grep  : case KEY_gt     : case KEY_last  : case KEY_le    :
+    case KEY_lt    : case KEY_map    : case KEY_ne    : case KEY_next  :
+    case KEY_or    : case KEY_print  : case KEY_printf: case KEY_qr    :
+    case KEY_redo  : case KEY_require: case KEY_return: case KEY_say   :
+    case KEY_select: case KEY_sort   : case KEY_split : case KEY_system:
+    case KEY_x     : case KEY_xor    :
 	if (!opnum) return NULL; nullret = TRUE; goto findopnum;
+    case KEY_glob:    retsetpvs("_;", OP_GLOB);
     case KEY_keys:    retsetpvs("+", OP_KEYS);
     case KEY_values:  retsetpvs("+", OP_VALUES);
     case KEY_each:    retsetpvs("+", OP_EACH);
@@ -10564,6 +10575,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
     case KEY_unshift: retsetpvs("+@", OP_UNSHIFT);
     case KEY_pop:     retsetpvs(";+", OP_POP);
     case KEY_shift:   retsetpvs(";+", OP_SHIFT);
+    case KEY_pos:     retsetpvs(";\\[$*]", OP_POS);
     case KEY_splice:
 	retsetpvs("+;$$@", OP_SPLICE);
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
@@ -10586,7 +10598,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
 	}
 	i++;
     }
-    assert(0); return NULL;    /* Should not happen... */
+    return NULL;
   found:
     defgv = PL_opargs[i] & OA_DEFGV;
     oa = PL_opargs[i] >> OASHIFT;
@@ -10610,7 +10622,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
 	    str[n++] = '$';
 	    str[n++] = '@';
 	    str[n++] = '%';
-	    if (i == OP_LOCK) str[n++] = '&';
+	    if (i == OP_LOCK || i == OP_UNDEF) str[n++] = '&';
 	    str[n++] = '*';
 	    str[n++] = ']';
 	}
@@ -10678,14 +10690,14 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
 	  onearg:
 	      if (is_handle_constructor(o, 1))
 		argop->op_private |= OPpCOREARGS_DEREF1;
+	      if (scalar_mod_type(NULL, opnum))
+		argop->op_private |= OPpCOREARGS_SCALARMOD;
 	    }
 	    return o;
 	default:
-	    o = convert(opnum,0,argop);
+	    o = convert(opnum,OPf_SPECIAL*(opnum == OP_GLOB),argop);
 	    if (is_handle_constructor(o, 2))
 		argop->op_private |= OPpCOREARGS_DEREF2;
-	    if (scalar_mod_type(NULL, opnum))
-		argop->op_private |= OPpCOREARGS_SCALARMOD;
 	    if (opnum == OP_SUBSTR) {
 		o->op_private |= OPpMAYBE_LVSUB;
 		return o;
diff --git a/opcode.h b/opcode.h
index 0a9628da92..f33f12403d 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1360,9 +1360,9 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
 	Perl_ck_spair,		/* chomp */
 	Perl_ck_null,		/* schomp */
 	Perl_ck_defined,	/* defined */
-	Perl_ck_lfun,		/* undef */
+	Perl_ck_fun,		/* undef */
 	Perl_ck_fun,		/* study */
-	Perl_ck_lfun,		/* pos */
+	Perl_ck_fun,		/* pos */
 	Perl_ck_lfun,		/* preinc */
 	Perl_ck_lfun,		/* i_preinc */
 	Perl_ck_lfun,		/* predec */
@@ -1746,9 +1746,9 @@ EXTCONST U32 PL_opargs[] = {
 	0x00002b1d,	/* chomp */
 	0x00009b9c,	/* schomp */
 	0x00009b84,	/* defined */
-	0x00009b04,	/* undef */
+	0x0000fb04,	/* undef */
 	0x00009b84,	/* study */
-	0x00009b8c,	/* pos */
+	0x0000fb8c,	/* pos */
 	0x00001164,	/* preinc */
 	0x00001144,	/* i_preinc */
 	0x00001164,	/* predec */
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 44491d91e1..3482f362eb 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -5154,8 +5154,8 @@ function has no prototype).  FUNCTION is a reference to, or the name of,
 the function whose prototype you want to retrieve.
 
 If FUNCTION is a string starting with C<CORE::>, the rest is taken as a
-name for a Perl builtin.  If the builtin is not I<overridable> (such as
-C<qw//>) or if its arguments cannot be adequately expressed by a prototype
+name for a Perl builtin.  If the builtin's arguments
+cannot be adequately expressed by a prototype
 (such as C<system>), prototype() returns C<undef>, because the builtin
 does not really behave like a Perl function.  Otherwise, the string
 describing the equivalent prototype is returned.
diff --git a/pp.c b/pp.c
index 444489b7aa..908d16d50a 100644
--- a/pp.c
+++ b/pp.c
@@ -440,7 +440,7 @@ PP(pp_prototype)
 	    const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
 	    if (!code || code == -KEY_CORE)
 		DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
-	    if (code < 0) {	/* Overridable. */
+	    {
 		SV * const sv = core_prototype(NULL, s + 6, code, NULL);
 		if (sv) ret = sv;
 	    }
@@ -5881,7 +5881,7 @@ PP(pp_coreargs)
 {
     dSP;
     int opnum = SvIOK(cSVOP_sv) ? (int)SvUV(cSVOP_sv) : 0;
-    int defgv = PL_opargs[opnum] & OA_DEFGV, whicharg = 0;
+    int defgv = PL_opargs[opnum] & OA_DEFGV ||opnum==OP_GLOB, whicharg = 0;
     AV * const at_ = GvAV(PL_defgv);
     SV **svp = at_ ? AvARRAY(at_) : NULL;
     I32 minargs = 0, maxargs = 0, numargs = at_ ? AvFILLp(at_)+1 : 0;
@@ -5906,7 +5906,7 @@ PP(pp_coreargs)
 	/* diag_listed_as: Too many arguments for %s */
 	Perl_croak(aTHX_
 	  "%s arguments for %s", err,
-	   opnum ? OP_DESC(PL_op->op_next) : SvPV_nolen_const(cSVOP_sv)
+	   opnum ? PL_op_desc[opnum] : SvPV_nolen_const(cSVOP_sv)
 	);
 
     /* Reset the stack pointer.  Without this, we end up returning our own
@@ -5934,6 +5934,7 @@ PP(pp_coreargs)
 	whicharg++;
 	switch (oa & 7) {
 	case OA_SCALAR:
+	  try_defsv:
 	    if (!numargs && defgv && whicharg == minargs + 1) {
 		PERL_SI * const oldsi = PL_curstackinfo;
 		I32 const oldcxix = oldsi->si_cxix;
@@ -5981,7 +5982,8 @@ PP(pp_coreargs)
 	    }
 	    break;
 	case OA_SCALARREF:
-	  {
+	  if (!numargs) goto try_defsv;
+	  else {
 	    const bool wantscalar =
 		PL_op->op_private & OPpCOREARGS_SCALARMOD;
 	    if (!svp || !*svp || !SvROK(*svp)
@@ -5990,23 +5992,33 @@ PP(pp_coreargs)
 	           type permits the latter. */
 	     || SvTYPE(SvRV(*svp)) > (
 	             wantscalar       ? SVt_PVLV
-	           : opnum == OP_LOCK ? SVt_PVCV
+	           : opnum == OP_LOCK || opnum == OP_UNDEF
+	                              ? SVt_PVCV
 	           :                    SVt_PVHV
 	        )
 	       )
 		DIE(aTHX_
 		/* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/
 		 "Type of arg %d to &CORE::%s must be %s",
-		  whicharg, OP_DESC(PL_op->op_next),
+		  whicharg, PL_op_name[opnum],
 		  wantscalar
 		    ? "scalar reference"
-		    : opnum == OP_LOCK
+		    : opnum == OP_LOCK || opnum == OP_UNDEF
 		       ? "reference to one of [$@%&*]"
 		       : "reference to one of [$@%*]"
 		);
 	    PUSHs(SvRV(*svp));
-	    break;
+	    if (opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv
+	     && cxstack[cxstack_ix].cx_type & CXp_HASARGS) {
+		/* Undo @_ localisation, so that sub exit does not undo
+		   part of our undeffing. */
+		PERL_CONTEXT *cx = &cxstack[cxstack_ix];
+		POP_SAVEARRAY();
+		cx->cx_type &= ~ CXp_HASARGS;
+		assert(!AvREAL(cx->blk_sub.argarray));
+	    }
 	  }
+	  break;
 	default:
 	    DIE(aTHX_ "panic: unknown OA_*: %x", (unsigned)(oa&7));
 	}
diff --git a/regen/opcodes b/regen/opcodes
index 0beba6a90d..d92c397882 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -103,9 +103,9 @@ schop		scalar chop		ck_null		stu%	S?
 chomp		chomp			ck_spair	mTs%	L
 schomp		scalar chomp		ck_null		sTu%	S?
 defined		defined operator	ck_defined	isu%	S?
-undef		undef operator		ck_lfun		s%	S?
+undef		undef operator		ck_fun		s%	R?
 study		study			ck_fun		su%	S?
-pos		match position		ck_lfun		stu%	S?
+pos		match position		ck_fun		stu%	R?
 
 preinc		preincrement (++)		ck_lfun		dIs1	S
 i_preinc	integer preincrement (++)	ck_lfun		dis1	S
diff --git a/t/comp/bproto.t b/t/comp/bproto.t
index bc0f1a291b..cd66278b72 100644
--- a/t/comp/bproto.t
+++ b/t/comp/bproto.t
@@ -8,7 +8,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..14\n";
+print "1..15\n";
 
 my $i = 1;
 
@@ -35,6 +35,7 @@ sub test_no_error {
 
 test_too_many($_) for split /\n/,
 q[	defined(&foo, $bar);
+	pos(1,$b);
 	undef(&foo, $bar);
 	uc($bar,$bar);
 ];
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 5fc0885e93..93e2c51e28 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -28,10 +28,13 @@ package sov {
 my %op_desc = (
  evalbytes=> 'eval "string"',
  join     => 'join or string',
+ pos      => 'match position',
+ prototype=> 'subroutine prototype',
  readline => '<HANDLE>',
  readpipe => 'quoted execution (``, qx)',
  reset    => 'symbol reset',
  ref      => 'reference-type operator',
+ undef    => 'undef operator',
 );
 sub op_desc($) {
   return $op_desc{$_[0]} || $_[0];
@@ -56,7 +59,7 @@ sub test_proto {
     like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
 
   }
-  elsif ($p eq '_') {
+  elsif ($p =~ /^_;?\z/) {
     $tests ++;
 
     eval " &CORE::$o(1,2) ";
@@ -187,41 +190,61 @@ sub test_proto {
     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)";
   }
-  elsif ($p =~ /^\\\[(\$\@%&?\*)](\$\@)?\z/) {
-    $tests += 4;
+  elsif ($p =~ /^(;)?\\\[(\$\@%&?\*)](\$\@)?\z/) {
+    $tests += 3;
 
-    unless ($2) {
+    unless ($3) {
       $tests ++;
       eval " &CORE::$o(1,2) ";
-      like $@, qr/^Too many arguments for $o at /,
+      like $@, qr/^Too many arguments for ${\op_desc($o)} at /,
         "&$o with too many args";
     }
-    eval { &{"CORE::$o"}($2 ? 1 : ()) };
-    like $@, qr/^Not enough arguments for $o at /,
+    unless ($1) {
+      $tests ++;
+      eval { &{"CORE::$o"}($3 ? 1 : ()) };
+      like $@, qr/^Not enough arguments for $o at /,
          "&$o with too few args";
-    my $more_args = $2 ? ',1' : '';
+    }
+    my $more_args = $3 ? ',1' : '';
     eval " &CORE::$o(2$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$1\E] at /,
+                ) \[\Q$2\E] at /,
         "&$o with non-ref arg";
     eval " &CORE::$o(*STDOUT{IO}$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$1\E] at /,
+                ) \[\Q$2\E] at /,
         "&$o with ioref arg";
     my $class = ref *DATA{IO};
     eval " &CORE::$o(bless(*DATA{IO}, 'hov')$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$1\E] at /,
+                ) \[\Q$2\E] at /,
         "&$o with ioref arg with hash overload (which does not count)";
     bless *DATA{IO}, $class;
-    if (do {$1 !~ /&/}) {
+    if (do {$2 !~ /&/}) {
       $tests++;
       eval " &CORE::$o(\\&scriggle$more_args) ";
       like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one (?x:
-                  )of \[\Q$1\E] at /,
+                  )of \[\Q$2\E] at /,
         "&$o with coderef arg";
     }    
   }
+  elsif ($p eq ';\[$*]') {
+    $tests += 4;
+
+    my $desc = quotemeta op_desc($o);
+    eval " &CORE::$o(1,2) ";
+    like $@, qr/^Too many arguments for $desc at /,
+        "&$o with too many args";
+    eval " &CORE::$o([]) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+        "&$o with array ref arg";
+    eval " &CORE::$o(1) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+        "&$o with scalar arg";
+    eval " &CORE::$o(bless([], 'sov')) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+        "&$o with non-scalar arg w/scalar overload (which does not count)";
+  }
 
   else {
     die "Please add tests for the $p prototype";
@@ -487,6 +510,20 @@ test_proto "get$_" for qw '
   pwent pwnam pwuid servbyname servbyport servent sockname sockopt
 ';
 
+# Make sure the following tests test what we think they are testing.
+ok ! $CORE::{glob}, '*CORE::glob not autovivified yet'; $tests ++;
+{
+  # Make sure ck_glob does not respect the override when &CORE::glob is
+  # autovivified (by test_proto).
+  local *CORE::GLOBAL::glob = sub {};
+  test_proto 'glob';
+}
+$_ = "t/*.t";
+@_ = &myglob($_);
+is join($", &myglob()), "@_", '&glob without arguments';
+is join($", &myglob("t/*.t")), "@_", '&glob with an arg';
+$tests += 2;
+
 test_proto 'gmtime';
 &CORE::gmtime;
 pass '&gmtime without args does not crash'; ++$tests;
@@ -571,6 +608,26 @@ is &mypack("H*", '5065726c'), 'Perl', '&pack';
 lis [&mypack("H*", '5065726c')], ['Perl'], '&pack in list context';
 
 test_proto 'pipe';
+
+test_proto 'pos';
+$tests += 4;
+$_ = "hello";
+pos = 3;
+is &mypos, 3, 'reading &pos without args';
+&mypos = 4;
+is pos, 4, 'writing to &pos without args';
+{
+  my $x = "gubai";
+  pos $x = 3;
+  is &mypos(\$x), 3, 'reading &pos without args';
+  &mypos(\$x) = 4;
+  is pos $x, 4, 'writing to &pos without args';
+}
+
+test_proto 'prototype';
+$tests++;
+is &myprototype(\&myprototype), prototype("CORE::prototype"), '&prototype';
+
 test_proto 'quotemeta', '$', '\$';
 
 test_proto 'rand';
@@ -668,6 +725,11 @@ is &myrindex("foffooo","o"),6,'&rindex with 2 args';
 
 test_proto 'rmdir';
 
+test_proto 'scalar';
+$tests += 2;
+is &myscalar(3), 3, '&scalar';
+lis [&myscalar(3)], [3], '&scalar in list cx';
+
 test_proto 'seek';
 {
     last if is_miniperl;
@@ -742,6 +804,8 @@ $tests ++;
 &CORE::srand;
 pass '&srand with no args does not crash';
 
+test_proto 'study';
+
 test_proto 'substr';
 $tests += 5;
 $_ = "abc";
@@ -815,6 +879,34 @@ test_proto 'umask';
 $tests ++;
 is &myumask, umask, '&umask with no args';
 
+test_proto 'undef';
+$tests += 12;
+is &myundef(), undef, '&undef returns undef';
+lis [&myundef()], [undef], '&undef returns undef in list cx';
+lis [&myundef(\$_)], [undef], '&undef(...) returns undef in list cx';
+is \&myundef(), \undef, '&undef returns the right undef';
+$_ = 'anserine questions';
+&myundef(\$_);
+is $_, undef, '&undef(\$_) undefines $_';
+@_ = 1..3;
+&myundef(\@_);
+is @_, 0, '&undef(\@_) undefines @_';
+%_ = 1..4;
+&myundef(\%_);
+ok !%_, '&undef(\%_) undefines %_';
+&myundef(\&utf8::valid); # nobody should be using this :-)
+ok !defined &utf8::valid, '&undef(\&foo) undefines &foo';
+@_ = \*_;
+&myundef;
+is *_{ARRAY}, undef, '@_=\*_, &undef undefines *_';
+@_ = \*_;
+&myundef(\*_);
+is *_{ARRAY}, undef, '&undef(\*_) undefines *_';
+(&myundef(), @_) = 1..10;
+lis \@_, [2..10], 'list assignment to &undef()';
+ok !defined undef, 'list assignment to &undef() does not affect undef'; 
+undef @_;
+
 test_proto 'unpack';
 $tests += 2;
 $_ = 'abcd';
@@ -882,10 +974,17 @@ like $@, qr'^Undefined format "STDOUT" called',
   open my $kh, $keywords_file
     or die "$0 cannot open $keywords_file: $!";
   while(<$kh>) {
-    if (m?__END__?..${\0} and /^[-](.*)/) {
+    if (m?__END__?..${\0} and /^[-+](.*)/) {
       my $word = $1;
       next if
-       $word =~ /^(?:CORE|and|cmp|dump|eq|ge|gt|le|lt|ne|or|x|xor)\z/;
+       $word =~ /^(?:s(?:tate|ort|ay|ub)?|d(?:ef
+                  ault|ump|o)|p(?:rintf?|ackag
+                  e)|e(?:ls(?:if|e)|val|q)|g(?:[et]|iven|oto
+                  |rep)|u(?:n(?:less|til)|se)|l(?:(?:as)?t|ocal|e)|re
+                  (?:quire|turn|do)|__(?:DATA|END)__|for(?:each|mat)?|(?:
+                  AUTOLOA|EN)D|n(?:e(?:xt)?|o)|C(?:HECK|ORE)|wh(?:ile|en)
+                  |(?:ou?|t)r|m(?:ap|y)?|UNITCHECK|q[qrwx]?|x(?:or)?|DEST
+                  ROY|BEGIN|INIT|and|cmp|if|y)\z/x;
       $tests ++;
       ok   exists &{"my$word"}
         || (eval{&{"CORE::$word"}}, $@ =~ /cannot be called directly/),
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 85084bb531..1909c0328f 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -15,11 +15,22 @@ BEGIN {
 use B::Deparse;
 my $bd = new B::Deparse '-p';
 
-my %unsupported = map +($_=>1), qw (CORE and cmp dump eq ge gt le
-                                    lt ne or x xor);
+my %unsupported = map +($_=>1), qw (
+ __DATA__ __END__ AUTOLOAD BEGIN UNITCHECK CORE DESTROY END INIT CHECK and
+  cmp default do dump else elsif eq eval for foreach
+  format ge given goto grep gt if last le local lt m map my ne next
+  no  or  our  package  print  printf  q  qq  qr  qw  qx  redo  require
+  return s say sort state sub tr unless until use
+  when while x xor y
+);
 my %args_for = (
   dbmopen  => '%1,$2,$3',
   dbmclose => '%1',
+  delete   => '$1[2]',
+  exists   => '$1[2]',
+);
+my %desc = (
+  pos => 'match position',
 );
 
 use File::Spec::Functions;
@@ -29,7 +40,7 @@ open my $kh, $keywords_file
 while(<$kh>) {
   if (m?__END__?..${\0} and /^[+-]/) {
     chomp(my $word = $');
-    if($& eq '+' || $unsupported{$word}) {
+    if($unsupported{$word}) {
       $tests ++;
       ok !defined &{"CORE::$word"}, "no CORE::$word";
     }
@@ -44,7 +55,8 @@ while(<$kh>) {
 
       CORE::state $protochar = qr/([^\\]|\\(?:[^[]|\[[^]]+\]))/;
       my $numargs =
-            () = $proto =~ s/;.*//r =~ /\G$protochar/g;
+            $word eq 'delete' || $word eq 'exists' ? 1 :
+            (() = $proto =~ s/;.*//r =~ /\G$protochar/g);
       my $code =
          "#line 1 This-line-makes-__FILE__-easier-to-test.
           sub { () = (my$word("
@@ -83,7 +95,8 @@ while(<$kh>) {
       next if ($proto =~ /\@/);
       # These ops currently accept any number of args, despite their
       # prototypes, if they have any:
-      next if $word =~ /^(?:chom?p|exec|keys|each|not|read(?:lin|pip)e
+      next if $word =~ /^(?:chom?p|exec|keys|each|not
+                           |(?:prototyp|read(?:lin|pip))e
                            |reset|system|values|l?stat)|evalbytes/x;
 
       $tests ++;
@@ -100,7 +113,8 @@ while(<$kh>) {
                )
        . "))}";
       eval $code;
-      like $@, qr/^Too many arguments for $word/,
+      my $desc = $desc{$word} || $word;
+      like $@, qr/^Too many arguments for $desc/,
           "inlined CORE::$word with too many args"
         or warn $code;
 
diff --git a/t/op/cproto.t b/t/op/cproto.t
index a6dc210b2e..85b86db419 100644
--- a/t/op/cproto.t
+++ b/t/op/cproto.t
@@ -129,7 +129,7 @@ getservent ()
 getsockname (*)
 getsockopt (*$$)
 given undef
-glob undef
+glob (_;)
 gmtime (;$)
 goto undef
 grep undef
@@ -177,10 +177,10 @@ pack ($@)
 package undef
 pipe (**)
 pop (;+)
-pos undef
+pos (;\[$*])
 print undef
 printf undef
-prototype undef
+prototype ($)
 push (+@)
 q undef
 qq undef
@@ -207,7 +207,7 @@ rindex ($$;$)
 rmdir (_)
 s undef
 say undef
-scalar undef
+scalar ($)
 seek (*$$)
 seekdir (*$)
 select undef
@@ -242,7 +242,7 @@ sqrt (_)
 srand (;$)
 stat (;*)
 state undef
-study undef
+study (_)
 sub undef
 substr ($$;$$)
 symlink ($$)
@@ -263,7 +263,7 @@ truncate ($$)
 uc (_)
 ucfirst (_)
 umask (;$)
-undef undef
+undef (;\[$@%&*])
 unless undef
 unlink (@)
 unpack ($_)