[perl #94306] Do not skip first elem of linear isa

Perl has assumed up till now that the first element of an isa linear-
isation is the name of the class itself.  That is true for dfs and c3,
but not requiring that makes it easier for plugin authors.

Since various parts of the mro code make that assumption, this commit
copies the AV returned by mro_alg.resolve to a new one beginning with
the class’s own name, if the original AV did not include it.

1 files changed, 23 insertions, 0 deletions

diff --git a/mro.c b/mro.c
index e0ab5bc96c..7f1bccc450 100644
--- a/mro.c
+++ b/mro.c
@@ -413,6 +413,29 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash)
         Perl_croak(aTHX_ "panic: invalid MRO!");
     isa = meta->mro_which->resolve(aTHX_ stash, 0);
 
+    if (meta->mro_which != &dfs_alg) { /* skip for dfs, for speed */
+	SV * const namesv =
+	    (HvENAME(stash)||HvNAME(stash))
+	      ? newSVhek(HvENAME_HEK(stash)
+			  ? HvENAME_HEK(stash)
+			  : HvNAME_HEK(stash))
+	      : NULL;
+
+	if(namesv && (AvFILLp(isa) == -1 || !sv_eq(*AvARRAY(isa), namesv)))
+	{
+	    AV * const old = isa;
+	    SV **svp;
+	    SV **ovp = AvARRAY(old);
+	    SV * const * const oend = ovp + AvFILLp(old) + 1;
+	    isa = (AV *)sv_2mortal((SV *)newAV());
+	    av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1);
+	    *AvARRAY(isa) = namesv;
+	    svp = AvARRAY(isa)+1;
+	    while (ovp < oend) *svp++ = SvREFCNT_inc(*ovp++);
+	}
+	else SvREFCNT_dec(namesv);
+    }
+
     if (!meta->isa) {
 	    HV *const isa_hash = newHV();
 	    /* Linearisation didn't build it for us, so do it here.  */