Add &CORE::undef

In the error message, we can’t say ‘&CORE::undef operator’, so we
should be using the op name, rather than the op description.

Instead of using OP_NAME(PL_op->op_next), which would expand to

    PL_op->op_next->op_type == OP_CUSTOM
	? XopENTRY(Perl_custom_op_xop(aTHX_ PL_op->op_next), xop_name)
	: PL_op_name[PL_op->op_next->op_type]

we can simply use PL_op_name[opnum], which should be quicker.

pp_undef can already handle nulls on the stack.

There is one remaining problem.  If &CORE::undef(\*_) is called, *_
will be undefined while @_ is localised during the sub call, so it
won’t have the same effect as undef *_.  I don’t know whether this
should be considered a bug or not, but I could solve it by making
pp_undef an XSUB.

diff --git a/gv.c b/gv.c
index acf7f9b..ab2aef1 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -471,7 +471,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     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_undef: case KEY_UNITCHECK: case KEY_unless:
+    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;

diff --git a/pp.c b/pp.c
index c89b083..0d4dfc4 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5992,17 +5992,18 @@ 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 [$@%*]"
                );

diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 0a17b17..0ac5796 100644 (file)
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -34,6 +34,7 @@ my %op_desc = (
  readpipe => 'quoted execution (``, qx)',
  reset    => 'symbol reset',
  ref      => 'reference-type operator',
+ undef    => 'undef operator',
 );
 sub op_desc($) {
   return $op_desc{$_[0]} || $_[0];
@@ -189,38 +190,41 @@ 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";
     }    
   }
@@ -875,6 +879,31 @@ test_proto 'umask';
 $tests ++;
 is &myumask, umask, '&umask with no args';
 
+test_proto 'undef';
+$tests += 11;
+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()}, @_) = 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';
@@ -948,7 +977,7 @@ like $@, qr'^Undefined format "STDOUT" called',
        $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|def|til)|se)|l(?:(?:as)?t|ocal|e)|re
+                  |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

diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 60db0fc..1909c03 100644 (file)
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -20,7 +20,7 @@ my %unsupported = map +($_=>1), qw (
   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 undef unless until use
+  return s say sort state sub tr unless until use
   when while x xor y
 );
 my %args_for = (