X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=61398fe4d1fd5a446d24816da906d87429039b4d;hb=d002ef56a2861d995ba1887bd9f3d10c8c74d149;hp=40b0eae67e283c283c9fec229d88d60057777e14;hpb=f1f66076265cc2bac3adabd54c01b0dea28ca3f0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/universal.c b/universal.c
index 40b0eae..61398fe 100644
--- a/universal.c
+++ b/universal.c
@@ -9,9 +9,11 @@
  */
 
 /*
- * "The roots of those mountains must be roots indeed; there must be
- * great secrets buried there which have not been discovered since the
- * beginning." --Gandalf, relating Gollum's story
+ * '"The roots of those mountains must be roots indeed; there must be
+ *   great secrets buried there which have not been discovered since the
+ *   beginning."'                   --Gandalf, relating Gollum's history
+ *
+ *     [p.54 of _The Lord of the Rings_, I/ii: "The Shadow of the Past"]
  */
 
 /* This file contains the code that implements the functions in Perl's
@@ -31,6 +33,41 @@
 #include "perliol.h" /* For the PERLIO_F_XXX */
 #endif
 
+static HV *
+S_get_isa_hash(pTHX_ HV *const stash)
+{
+    dVAR;
+    struct mro_meta *const meta = HvMROMETA(stash);
+
+    PERL_ARGS_ASSERT_GET_ISA_HASH;
+
+    if (!meta->isa) {
+	AV *const isa = mro_get_linear_isa(stash);
+	if (!meta->isa) {
+	    HV *const isa_hash = newHV();
+	    /* Linearisation didn't build it for us, so do it here.  */
+	    SV *const *svp = AvARRAY(isa);
+	    SV *const *const svp_end = svp + AvFILLp(isa) + 1;
+	    const HEK *const canon_name = HvNAME_HEK(stash);
+
+	    while (svp < svp_end) {
+		(void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0);
+	    }
+
+	    (void) hv_common(isa_hash, NULL, HEK_KEY(canon_name),
+			     HEK_LEN(canon_name), HEK_FLAGS(canon_name),
+			     HV_FETCH_ISSTORE, &PL_sv_undef,
+			     HEK_HASH(canon_name));
+	    (void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
+
+	    SvREADONLY_on(isa_hash);
+
+	    meta->isa = isa_hash;
+	}
+    }
+    return meta->isa;
+}
+
 /*
  * Contributed by Graham Barr  <Graham.Barr@tiuk.ti.com>
  * The main guts of traverse_isa was actually copied from gv_fetchmeth
@@ -41,7 +78,7 @@ S_isa_lookup(pTHX_ HV *stash, const char * const name)
 {
     dVAR;
     const struct mro_meta *const meta = HvMROMETA(stash);
-    HV *const isa = meta->isa ? meta->isa : Perl_get_isa_hash(aTHX_ stash);
+    HV *const isa = meta->isa ? meta->isa : S_get_isa_hash(aTHX_ stash);
     STRLEN len = strlen(name);
     const HV *our_stash;
 
@@ -200,7 +237,6 @@ XS(XS_Regexp_DESTROY);
 XS(XS_Internals_hash_seed);
 XS(XS_Internals_rehash_seed);
 XS(XS_Internals_HvREHASH);
-XS(XS_Internals_inc_sub_generation);
 XS(XS_re_is_regexp); 
 XS(XS_re_regname);
 XS(XS_re_regnames);
@@ -988,7 +1024,7 @@ XS(XS_PerlIO_get_layers)
 					       (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
 					       | SVs_TEMP)
 			      : &PL_sv_undef);
-		       XPUSHs(namok
+		       XPUSHs(flgok
 			      ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
 			      : &PL_sv_undef);
 		       nitem += 3;