Add &CORE::glob

I added a special case for OP_GLOB to pp_coreargs, since glob does not
have the u flag in regen/opcodes; hence PL_opargs[opnum] & OA_DEFGV is
false, even though glob does imply $_.

Adding the flag to regen/opcodes is not so simple, as the code in
ck_fun that adds the DEFSV op does not account for list ops, but
leaves op_last unchanged.

Changing ck_fun to account requires adding more code than this special
case in pp_coreargs.

OPf_SPECIAL indicates that glob was called with the CORE:: prefix.

diff --git a/gv.c b/gv.c
index e014f44..5185af8 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -462,7 +462,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     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_glob   : case KEY_goto  : case KEY_grep   :
+    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:

diff --git a/op.c b/op.c
index cf2f9fa..8bd45bf 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10688,7 +10688,7 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
            }
            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))

diff --git a/pp.c b/pp.c
index 5fecd03..b1ab8b9 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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;

diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 094732e..79af783 100644 (file)
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -56,7 +56,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) ";
@@ -487,6 +487,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;
@@ -887,7 +901,7 @@ like $@, qr'^Undefined format "STDOUT" called',
       next if
        $word =~ /^(?:s(?:t(?:ate|udy)|(?:pli|or)t|calar|ay|ub)?|d(?:ef
                   ault|ump|o)|p(?:r(?:ototype|intf?)|ackag
-                  e|os)|e(?:ls(?:if|e)|val|q)|g(?:[et]|iven|lob|oto
+                  e|os)|e(?:ls(?:if|e)|val|q)|g(?:[et]|iven|oto
                   |rep)|u(?:n(?:less|def|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)

diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 7c002ec..e6fcbd9 100644 (file)
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -18,7 +18,7 @@ my $bd = new B::Deparse '-p';
 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 glob goto grep gt if last le local lt m map my  ne  next
+  format ge given goto grep gt if last le local lt m map my ne next
   no or our package pos print printf prototype q qq qr qw qx redo  require
   return s say scalar sort split state study sub tr undef unless until use
   when while x xor y