Delay @ISA magic while unshifting

pp_unshift() first calls av_unshift(), which prepends the the
requisite number of undefs, then calls av_store() for each item.
However, unlike pp_push() it was not setting PL_delaymagic around the
av_store() loop, so when unshifting onto @ISA, its magic would be
triggered while there were still undefs in the array, causig the
following spurious warning:

    $ perl -wE 'package Foo; unshift @ISA, qw(A B)'
    Use of uninitialized value in unshift at -e line 1.

Also fix pp_push() to save and restore PL_delaymagic instead of
clearing it, so that e.g. unshifting a tied value with FETCH pushing
onto another @ISA doesn't erroneously clear the value from underneath
the unshift.

diff --git a/pp.c b/pp.c
index 6a844c2..b84747a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5444,6 +5444,8 @@ PP(pp_push)
     }
     else {
        if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify();
+        ENTER;
+        SAVEI16(PL_delaymagic);
        PL_delaymagic = DM_DELAY;
        for (++MARK; MARK <= SP; MARK++) {
            SV *sv;
@@ -5455,8 +5457,7 @@ PP(pp_push)
        }
        if (PL_delaymagic & DM_ARRAY_ISA)
            mg_set(MUTABLE_SV(ary));
-
-       PL_delaymagic = 0;
+        LEAVE;
     }
     SP = ORIGMARK;
     if (OP_GIMME(PL_op, 0) != G_VOID) {
@@ -5498,10 +5499,16 @@ PP(pp_unshift)
     else {
        SSize_t i = 0;
        av_unshift(ary, SP - MARK);
+        ENTER;
+        SAVEI16(PL_delaymagic);
+        PL_delaymagic = DM_DELAY;
        while (MARK < SP) {
            SV * const sv = newSVsv(*++MARK);
            (void)av_store(ary, i++, sv);
        }
+        if (PL_delaymagic & DM_ARRAY_ISA)
+            mg_set(MUTABLE_SV(ary));
+        LEAVE;
     }
     SP = ORIGMARK;
     if (OP_GIMME(PL_op, 0) != G_VOID) {

diff --git a/t/op/magic.t b/t/op/magic.t
index 4a8006d..da7532e 100644 (file)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 190);
+    plan (tests => 192);
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -681,6 +681,27 @@ $_ = ${^E_NCODING};
 pass('can read ${^E_NCODING} without blowing up');
 is $_, undef, '${^E_NCODING} is undef';
 
+{
+    my $warned = 0;
+    local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; };
+    unshift @RT12608::A::ISA, qw(RT12608::B RT12608::C);
+    is $warned, 0, '[perl #126082] unshifting onto @ISA doesn\'t trigger set magic for each item';
+}
+
+{
+    my $warned = 0;
+    local $SIG{__WARN__} = sub { ++$warned if $_[0] =~ /Use of uninitialized value in unshift/; print "# @_"; };
+
+    my $x; tie $x, 'RT12608::F';
+    unshift @RT12608::X::ISA, $x, "RT12608::Z";
+    is $warned, 0, '[perl #126082] PL_delaymagic correctly/saved restored when pushing/unshifting onto @ISA';
+
+    package RT12608::F;
+    use parent 'Tie::Scalar';
+    sub TIESCALAR { bless {}; }
+    sub FETCH { push @RT12608::G::ISA, "RT12608::H"; "RT12608::Y"; }
+}
+
 # ^^^^^^^^^ New tests go here ^^^^^^^^^
 
 SKIP: {