Make &CORE::undef(\*_) undefine it properly

Unless called as &CORE::undef (without parentheses) after @_ has been
set to \*_, it leaves @_ in the ARRAY slot.

This is an implementation detail leaking through.

pp_entersub temporarily aliases @_ to a new array, which is restored
to its previous value on sub exit.

Since &CORE::undef is a perl sub with an op tree containing
an undef op,

$ ./perl -Ilib -MO=Concise,CORE::undef -e '\&CORE::undef'
CORE::undef:
3  <1> leavesublv[1 ref] K/REFC,1 ->(end)
2     <1> undef sKP/1 ->3
1        <$> coreargs(IV 44) s ->2
-e syntax OK

the undef op runs while @_ is localised.

So we should un-localise @_ if we detect that case.

Doing this in pp_coreargs might be a bit of a hack, but it’s less
code than rewriting &CORE::undef as an XSUB, which would be the
other option.

Either way, we need a special case, since undef is the only named op
that touches the ARRAY slot of the glob passed to it.

2 files changed, 13 insertions, 1 deletions

diff --git a/pp.c b/pp.c
index 0d4dfc4037..908d16d50a 100644
--- a/pp.c
+++ b/pp.c
@@ -6008,6 +6008,15 @@ PP(pp_coreargs)
 		       : "reference to one of [$@%*]"
 		);
 	    PUSHs(SvRV(*svp));
+	    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:
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 9e271b5c2a..93e2c51e28 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -880,7 +880,7 @@ $tests ++;
 is &myumask, umask, '&umask with no args';
 
 test_proto 'undef';
-$tests += 11;
+$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';
@@ -898,6 +898,9 @@ ok !%_, '&undef(\%_) undefines %_';
 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()';