In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/94f9945d6a41925a75e4133e35315328b8f6dc39?hp=0927ade08b4a98671d253366f66b984dc77ed512>

- Log -----------------------------------------------------------------
commit 94f9945d6a41925a75e4133e35315328b8f6dc39
Author: Father Chrysostomos <[email protected]>
Date:   Tue May 17 00:03:09 2016 -0700

    Fix crash with: undef *_; shift;
    
    Commit v5.13.0-149-g538f575 added on optimisation to shift() that
    makes pp_shift fetch @_ directly, instead of having two separate ops.
    
    Unfortunately, it used the wrong macro, namely GvAV, instead of GvAVn.
    The latter makes sure the array actually exists.

M       pp.c
M       t/op/array.t

commit 005767288eb2ed82608caafeaad3b0c1aed852fb
Author: Father Chrysostomos <[email protected]>
Date:   Mon May 16 23:42:09 2016 -0700

    Remove some autoderef leftovers

M       pod/perldiag.pod
M       pp.c
-----------------------------------------------------------------------

Summary of changes:
 pod/perldiag.pod |  6 ------
 pp.c             | 38 ++++----------------------------------
 t/op/array.t     |  3 +++
 3 files changed, 7 insertions(+), 40 deletions(-)

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index b949729..01f9e29 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4002,12 +4002,6 @@ find out what kind of ref it really was.  See L<perlref>.
 a reference to something else instead.  You can use the ref() function
 to find out what kind of ref it really was.  See L<perlref>.
 
-=item Not an unblessed ARRAY reference
-
-(F) You passed a reference to a blessed array to C<push>, C<shift> or
-another array function.  These only accept unblessed array references
-or arrays beginning explicitly with C<@>.
-
 =item Not a SCALAR reference
 
 (F) Perl was trying to evaluate a reference to a scalar value, but found
diff --git a/pp.c b/pp.c
index 0fff0d9..5010065 100644
--- a/pp.c
+++ b/pp.c
@@ -5307,41 +5307,11 @@ PP(pp_anonhash)
     RETURN;
 }
 
-static AV *
-S_deref_plain_array(pTHX_ AV *ary)
-{
-    if (SvTYPE(ary) == SVt_PVAV) return ary;
-    SvGETMAGIC((SV *)ary);
-    if (!SvROK(ary) || SvTYPE(SvRV(ary)) != SVt_PVAV)
-       Perl_die(aTHX_ "Not an ARRAY reference");
-    else if (SvOBJECT(SvRV(ary)))
-       Perl_die(aTHX_ "Not an unblessed ARRAY reference");
-    return (AV *)SvRV(ary);
-}
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define DEREF_PLAIN_ARRAY(ary)       \
-   ({                                  \
-     AV *aRrRay = ary;                  \
-     SvTYPE(aRrRay) == SVt_PVAV          \
-      ? aRrRay                            \
-      : S_deref_plain_array(aTHX_ aRrRay); \
-   })
-#else
-# define DEREF_PLAIN_ARRAY(ary)            \
-   (                                        \
-     PL_Sv = (SV *)(ary),                    \
-     SvTYPE(PL_Sv) == SVt_PVAV                \
-      ? (AV *)PL_Sv                            \
-      : S_deref_plain_array(aTHX_ (AV *)PL_Sv)  \
-   )
-#endif
-
 PP(pp_splice)
 {
     dSP; dMARK; dORIGMARK;
     int num_args = (SP - MARK);
-    AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+    AV *ary = MUTABLE_AV(*++MARK);
     SV **src;
     SV **dst;
     SSize_t i;
@@ -5550,7 +5520,7 @@ PP(pp_splice)
 PP(pp_push)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
-    AV * const ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+    AV * const ary = MUTABLE_AV(*++MARK);
     const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
 
     if (mg) {
@@ -5593,7 +5563,7 @@ PP(pp_shift)
 {
     dSP;
     AV * const av = PL_op->op_flags & OPf_SPECIAL
-       ? MUTABLE_AV(GvAV(PL_defgv)) : DEREF_PLAIN_ARRAY(MUTABLE_AV(POPs));
+       ? MUTABLE_AV(GvAVn(PL_defgv)) : MUTABLE_AV(POPs);
     SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
     EXTEND(SP, 1);
     assert (sv);
@@ -5606,7 +5576,7 @@ PP(pp_shift)
 PP(pp_unshift)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
-    AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+    AV *ary = MUTABLE_AV(*++MARK);
     const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
 
     if (mg) {
diff --git a/t/op/array.t b/t/op/array.t
index 4f0a772..c8513d1 100644
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -555,4 +555,7 @@ is $#foo, 3, 'assigning to arylen aliased in foreach(scalar 
$#arylen)';
     is "@a", 'a b c', 'assigning to itself';
 }
 
+sub { undef *_; shift }->(); # This would crash; no ok() necessary.
+sub { undef *_; pop   }->();
+
 "We're included by lib/Tie/Array/std.t so we need to return something true";

--
Perl5 Master Repository

Reply via email to