This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make &CORE::undef(\*_) undefine it properly
authorFather Chrysostomos <sprout@cpan.org>
Tue, 15 May 2012 05:26:15 +0000 (22:26 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 29 May 2012 16:36:28 +0000 (09:36 -0700)
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.

pp.c
t/op/coreamp.t

diff --git a/pp.c b/pp.c
index 0d4dfc4..908d16d 100644 (file)
--- 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:
index 9e271b5..93e2c51 100644 (file)
@@ -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()';