From: Brandon L Black Date: Mon, 18 Dec 2006 06:30:14 +0000 (+0000) Subject: newer c3.patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=78b390050d88d456dba369be3eafaeb1f14d9a39;p=gitmo%2FClass-C3.git newer c3.patch --- diff --git a/c3.patch b/c3.patch index ddd2939..edde5e1 100644 --- a/c3.patch +++ b/c3.patch @@ -1,7 +1,7 @@ === Makefile.micro ================================================================== ---- Makefile.micro (/local/perl-current) (revision 12419) -+++ Makefile.micro (/local/perl-c3) (revision 12419) +--- Makefile.micro (/local/perl-current) (revision 12457) ++++ Makefile.micro (/local/perl-c3) (revision 12457) @@ -9,7 +9,7 @@ all: microperl @@ -23,8 +23,8 @@ === embed.h ================================================================== ---- embed.h (/local/perl-current) (revision 12419) -+++ embed.h (/local/perl-c3) (revision 12419) +--- embed.h (/local/perl-current) (revision 12457) ++++ embed.h (/local/perl-c3) (revision 12457) @@ -266,6 +266,9 @@ #define gv_efullname Perl_gv_efullname #define gv_efullname4 Perl_gv_efullname4 @@ -40,15 +40,15 @@ #define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d) #define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a) +#define mro_linear(a) Perl_mro_linear(aTHX_ a) -+#define mro_linear_c3(a) Perl_mro_linear_c3(aTHX_ a) ++#define mro_linear_c3(a,b) Perl_mro_linear_c3(aTHX_ a,b) +#define mro_linear_dfs(a,b) Perl_mro_linear_dfs(aTHX_ a,b) #define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d) #define gv_fetchmeth_autoload(a,b,c,d) Perl_gv_fetchmeth_autoload(aTHX_ a,b,c,d) #define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_ a,b,c) === embedvar.h ================================================================== ---- embedvar.h (/local/perl-current) (revision 12419) -+++ embedvar.h (/local/perl-c3) (revision 12419) +--- embedvar.h (/local/perl-current) (revision 12457) ++++ embedvar.h (/local/perl-c3) (revision 12457) @@ -229,6 +229,7 @@ #define PL_incgv (vTHX->Iincgv) #define PL_initav (vTHX->Iinitav) @@ -57,7 +57,7 @@ #define PL_known_layers (vTHX->Iknown_layers) #define PL_last_lop (vTHX->Ilast_lop) #define PL_last_lop_op (vTHX->Ilast_lop_op) -@@ -527,6 +528,7 @@ +@@ -526,6 +527,7 @@ #define PL_Iincgv PL_incgv #define PL_Iinitav PL_initav #define PL_Iinplace PL_inplace @@ -67,8 +67,8 @@ #define PL_Ilast_lop_op PL_last_lop_op === pod/perlapi.pod ================================================================== ---- pod/perlapi.pod (/local/perl-current) (revision 12419) -+++ pod/perlapi.pod (/local/perl-c3) (revision 12419) +--- pod/perlapi.pod (/local/perl-current) (revision 12457) ++++ pod/perlapi.pod (/local/perl-c3) (revision 12457) @@ -1280,7 +1280,7 @@ The argument C should be either 0 or -1. If C, as a side-effect creates a glob with the given C in the given C @@ -80,8 +80,8 @@ GV returned from C may be a method cache entry, which is not === global.sym ================================================================== ---- global.sym (/local/perl-current) (revision 12419) -+++ global.sym (/local/perl-c3) (revision 12419) +--- global.sym (/local/perl-current) (revision 12457) ++++ global.sym (/local/perl-c3) (revision 12457) @@ -133,6 +133,9 @@ Perl_gv_efullname3 Perl_gv_efullname4 @@ -94,8 +94,8 @@ Perl_gv_fetchmethod === universal.c ================================================================== ---- universal.c (/local/perl-current) (revision 12419) -+++ universal.c (/local/perl-c3) (revision 12419) +--- universal.c (/local/perl-current) (revision 12457) ++++ universal.c (/local/perl-c3) (revision 12457) @@ -36,12 +36,10 @@ int len, int level) { @@ -207,8 +207,8 @@ === gv.c ================================================================== ---- gv.c (/local/perl-current) (revision 12419) -+++ gv.c (/local/perl-c3) (revision 12419) +--- gv.c (/local/perl-current) (revision 12457) ++++ gv.c (/local/perl-c3) (revision 12457) @@ -298,7 +298,7 @@ The argument C should be either 0 or -1. If C, as a side-effect creates a glob with the given C in the given C @@ -458,8 +458,8 @@ return 0; === perlapi.h ================================================================== ---- perlapi.h (/local/perl-current) (revision 12419) -+++ perlapi.h (/local/perl-c3) (revision 12419) +--- perlapi.h (/local/perl-current) (revision 12457) ++++ perlapi.h (/local/perl-c3) (revision 12457) @@ -336,6 +336,8 @@ #define PL_initav (*Perl_Iinitav_ptr(aTHX)) #undef PL_inplace @@ -471,8 +471,8 @@ #undef PL_last_lop === win32/Makefile ================================================================== ---- win32/Makefile (/local/perl-current) (revision 12419) -+++ win32/Makefile (/local/perl-c3) (revision 12419) +--- win32/Makefile (/local/perl-current) (revision 12457) ++++ win32/Makefile (/local/perl-c3) (revision 12457) @@ -644,6 +644,7 @@ ..\dump.c \ ..\globals.c \ @@ -483,8 +483,8 @@ ..\mathoms.c \ === win32/makefile.mk ================================================================== ---- win32/makefile.mk (/local/perl-current) (revision 12419) -+++ win32/makefile.mk (/local/perl-c3) (revision 12419) +--- win32/makefile.mk (/local/perl-current) (revision 12457) ++++ win32/makefile.mk (/local/perl-c3) (revision 12457) @@ -813,6 +813,7 @@ ..\dump.c \ ..\globals.c \ @@ -495,8 +495,8 @@ ..\mathoms.c \ === win32/Makefile.ce ================================================================== ---- win32/Makefile.ce (/local/perl-current) (revision 12419) -+++ win32/Makefile.ce (/local/perl-c3) (revision 12419) +--- win32/Makefile.ce (/local/perl-current) (revision 12457) ++++ win32/Makefile.ce (/local/perl-c3) (revision 12457) @@ -571,6 +571,7 @@ ..\dump.c \ ..\globals.c \ @@ -515,8 +515,8 @@ $(DLLDIR)\mathoms.obj \ === NetWare/Makefile ================================================================== ---- NetWare/Makefile (/local/perl-current) (revision 12419) -+++ NetWare/Makefile (/local/perl-c3) (revision 12419) +--- NetWare/Makefile (/local/perl-current) (revision 12457) ++++ NetWare/Makefile (/local/perl-c3) (revision 12457) @@ -701,6 +701,7 @@ ..\dump.c \ ..\globals.c \ @@ -527,8 +527,8 @@ ..\mathoms.c \ === vms/descrip_mms.template ================================================================== ---- vms/descrip_mms.template (/local/perl-current) (revision 12419) -+++ vms/descrip_mms.template (/local/perl-c3) (revision 12419) +--- vms/descrip_mms.template (/local/perl-current) (revision 12457) ++++ vms/descrip_mms.template (/local/perl-c3) (revision 12457) @@ -279,13 +279,13 @@ #### End of system configuration section. #### @@ -556,8 +556,8 @@ locale$(O) : locale.c $(h) === Makefile.SH ================================================================== ---- Makefile.SH (/local/perl-current) (revision 12419) -+++ Makefile.SH (/local/perl-c3) (revision 12419) +--- Makefile.SH (/local/perl-current) (revision 12457) ++++ Makefile.SH (/local/perl-c3) (revision 12457) @@ -364,7 +364,7 @@ h5 = utf8.h warnings.h h = $(h1) $(h2) $(h3) $(h4) $(h5) @@ -578,8 +578,8 @@ === proto.h ================================================================== ---- proto.h (/local/perl-current) (revision 12419) -+++ proto.h (/local/perl-c3) (revision 12419) +--- proto.h (/local/perl-current) (revision 12457) ++++ proto.h (/local/perl-c3) (revision 12457) @@ -624,6 +624,15 @@ PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name) __attribute__nonnull__(pTHX_1); @@ -587,7 +587,7 @@ +PERL_CALLCONV AV* Perl_mro_linear(pTHX_ HV* stash) + __attribute__nonnull__(pTHX_1); + -+PERL_CALLCONV AV* Perl_mro_linear_c3(pTHX_ HV* stash) ++PERL_CALLCONV AV* Perl_mro_linear_c3(pTHX_ HV* stash, I32 level) + __attribute__nonnull__(pTHX_1); + +PERL_CALLCONV AV* Perl_mro_linear_dfs(pTHX_ HV* stash, I32 level) @@ -598,8 +598,8 @@ === ext/B/t/concise-xs.t ================================================================== ---- ext/B/t/concise-xs.t (/local/perl-current) (revision 12419) -+++ ext/B/t/concise-xs.t (/local/perl-c3) (revision 12419) +--- ext/B/t/concise-xs.t (/local/perl-current) (revision 12457) ++++ ext/B/t/concise-xs.t (/local/perl-c3) (revision 12457) @@ -117,7 +117,7 @@ use Carp; use Test::More tests => ( # per-pkg tests (function ct + require_ok) @@ -620,8 +620,8 @@ === ext/B/B.xs ================================================================== ---- ext/B/B.xs (/local/perl-current) (revision 12419) -+++ ext/B/B.xs (/local/perl-c3) (revision 12419) +--- ext/B/B.xs (/local/perl-current) (revision 12457) ++++ ext/B/B.xs (/local/perl-c3) (revision 12457) @@ -604,6 +604,7 @@ #define B_main_start() PL_main_start #define B_amagic_generation() PL_amagic_generation @@ -642,8 +642,8 @@ === ext/B/B.pm ================================================================== ---- ext/B/B.pm (/local/perl-current) (revision 12419) -+++ ext/B/B.pm (/local/perl-c3) (revision 12419) +--- ext/B/B.pm (/local/perl-current) (revision 12457) ++++ ext/B/B.pm (/local/perl-c3) (revision 12457) @@ -23,6 +23,7 @@ parents comppadlist sv_undef compile_stats timing_info begin_av init_av unitcheck_av check_av end_av regex_padav @@ -654,8 +654,8 @@ sub OPf_KIDS (); === ext/mro/mro.xs ================================================================== ---- ext/mro/mro.xs (/local/perl-current) (revision 12419) -+++ ext/mro/mro.xs (/local/perl-c3) (revision 12419) +--- ext/mro/mro.xs (/local/perl-current) (revision 12457) ++++ ext/mro/mro.xs (/local/perl-c3) (revision 12457) @@ -0,0 +1,90 @@ +/* mro.xs + * @@ -702,7 +702,7 @@ + HV* class_stash; + class_stash = gv_stashsv(classname, 0); + if(!class_stash) croak("No such class: '%"SVf"'!", classname); -+ RETVAL = mro_linear_c3(class_stash); ++ RETVAL = mro_linear_c3(class_stash, 0); + OUTPUT: + RETVAL + @@ -749,8 +749,8 @@ + RETVAL === ext/mro/Makefile.PL ================================================================== ---- ext/mro/Makefile.PL (/local/perl-current) (revision 12419) -+++ ext/mro/Makefile.PL (/local/perl-c3) (revision 12419) +--- ext/mro/Makefile.PL (/local/perl-current) (revision 12457) ++++ ext/mro/Makefile.PL (/local/perl-c3) (revision 12457) @@ -0,0 +1,35 @@ +use ExtUtils::MakeMaker; +use Config; @@ -789,8 +789,8 @@ +} === ext/mro/mro.pm ================================================================== ---- ext/mro/mro.pm (/local/perl-current) (revision 12419) -+++ ext/mro/mro.pm (/local/perl-c3) (revision 12419) +--- ext/mro/mro.pm (/local/perl-current) (revision 12457) ++++ ext/mro/mro.pm (/local/perl-c3) (revision 12457) @@ -0,0 +1,91 @@ +# mro.pm +# @@ -885,8 +885,8 @@ +=cut === MANIFEST ================================================================== ---- MANIFEST (/local/perl-current) (revision 12419) -+++ MANIFEST (/local/perl-c3) (revision 12419) +--- MANIFEST (/local/perl-current) (revision 12457) ++++ MANIFEST (/local/perl-c3) (revision 12457) @@ -893,6 +893,9 @@ ext/MIME/Base64/t/quoted-print.t See whether MIME::QuotedPrint works ext/MIME/Base64/t/unicode.t See whether MIME::Base64 works @@ -907,9 +907,9 @@ NetWare/bat/SetCodeWar.bat NetWare port === mro.c ================================================================== ---- mro.c (/local/perl-current) (revision 12419) -+++ mro.c (/local/perl-c3) (revision 12419) -@@ -0,0 +1,362 @@ +--- mro.c (/local/perl-current) (revision 12457) ++++ mro.c (/local/perl-c3) (revision 12457) +@@ -0,0 +1,278 @@ +/* mro.c + * + * Copyright (C) 2006 by Larry Wall and others @@ -1019,108 +1019,74 @@ + +=cut +*/ ++ +AV* -+Perl_mro_linear_c3(pTHX_ HV *root) { ++Perl_mro_linear_c3(pTHX_ HV* root, I32 level) { + AV* retval; + GV** gvp; + GV* gv; -+ AV* crisa; -+ SV** svp; ++ AV* isa; + const char* rootname; -+ AV* C3STACK; -+ HV* current_root; -+ AV* recurse_mergeout; -+ SV* isv; -+ HV* seen; ++ STRLEN rootname_len; + + assert(root); + assert(HvAUX(root)); + + rootname = HvNAME_get(root); ++ rootname_len = HvNAMELEN_get(root); + if (!rootname) + Perl_croak(aTHX_ + "Can't linearize anonymous symbol table"); + -+ /* shortcut in the case root's linear isa is already cached */ -+ if((retval = HvAUX(root)->xhv_mro_linear_c3) -+ && (HvAUX(root)->xhv_mro_linear_c3_gen == PL_isa_generation)) { -+ SvREFCNT_inc_simple_void_NN(retval); -+ return retval; -+ } -+ -+ C3STACK = newAV(); /* our recursion-via-iteration stack ... */ -+ current_root = root; /* the current stash being examined */ -+ recurse_mergeout = newAV(); /* where we iteratively gather the results at */ -+ isv = newSViv(0); /* index within @ISA for current_root */ -+ seen = newHV(); /* this tracks infinite recursion in @ISA for us */ -+ hv_store(seen, rootname, strlen(rootname), &PL_sv_yes, 0); /* obviously, we've seen "root" */ -+ -+ while(1) { -+ gvp = (GV**)hv_fetchs(current_root, "ISA", FALSE); -+ crisa = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL; -+ -+ if(crisa && SvIVX(isv) <= av_len(crisa)) { -+ AV* new_stack_entry; -+ SV* new_root_sv; -+ HV* new_root; -+ const char* new_root_name; -+ int new_root_len; -+ svp = av_fetch(crisa, SvIVX(isv), 0); -+ assert(svp); -+ new_root_sv = *svp; -+ new_root = gv_stashsv(new_root_sv, FALSE); -+ assert(new_root); -+ sv_inc(isv); -+ -+ new_root_name = HvNAME_get(new_root); -+ new_root_len = HvNAMELEN_get(new_root); -+ if(hv_exists(seen, new_root_name, new_root_len)) { -+ Perl_croak(aTHX_ "infinite recursion detected"); -+ } -+ hv_store(seen, new_root_name, new_root_len, &PL_sv_yes, 0); -+ -+ new_stack_entry = newAV(); -+ av_push(new_stack_entry, (SV*)current_root); -+ av_push(new_stack_entry, (SV*)recurse_mergeout); -+ av_push(new_stack_entry, isv); -+ av_push(C3STACK, (SV*)new_stack_entry); ++ if (level > 100) ++ Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'", ++ rootname); + -+ current_root = new_root; -+ recurse_mergeout = newAV(); -+ isv = newSViv(0); -+ continue; ++ if((retval = HvAUX(root)->xhv_mro_linear_c3)) { ++ if(HvAUX(root)->xhv_mro_linear_c3_gen == PL_isa_generation) { ++ /* return cache if valid */ ++ SvREFCNT_inc_simple_void_NN(retval); ++ return retval; + } ++ /* decref old cache and forget it */ ++ SvREFCNT_dec(retval); ++ HvAUX(root)->xhv_mro_linear_c3 = NULL; ++ } + -+ const char* current_root_name = HvNAME_get(current_root); -+ int current_root_len = HvNAMELEN_get(current_root); -+ SV* current_root_name_sv = newSVpv(current_root_name, current_root_len); -+ hv_delete(seen, current_root_name, current_root_len, G_DISCARD); -+ -+ AV* res = HvAUX(current_root)->xhv_mro_linear_c3; -+ if(!res || HvAUX(current_root)->xhv_mro_linear_c3_gen != PL_isa_generation) { -+ if(res) SvREFCNT_dec(res); -+ res = newAV(); -+ HV* tails = newHV(); -+ AV* seqs = newAV(); -+ av_push(res, current_root_name_sv); -+ -+ SV** avptr = AvARRAY(recurse_mergeout); -+ I32 items = AvFILLp(recurse_mergeout) + 1; -+ while(items--) { -+ AV* oseq = (AV*)*avptr++; -+ AV* seq = newAV(); -+ SV** seqptr = AvARRAY(oseq); -+ I32 seqitems = AvFILLp(oseq) + 1; -+ while(seqitems--) { -+ SV* tempsv = *seqptr++; -+ SvREFCNT_inc_simple_void_NN(tempsv); -+ av_push(seq, tempsv); -+ } -+ av_push(seqs, (SV*)seq); -+ seqptr = AvARRAY(seq) + 1; -+ seqitems = AvFILLp(seq); -+ while(seqitems--) { -+ SV* seqitem = *(seqptr++); ++ retval = (AV*)sv_2mortal((SV*)newAV()); ++ av_push(retval, newSVpvn(rootname, rootname_len)); /* root first */ ++ ++ gvp = (GV**)hv_fetchs(root, "ISA", FALSE); ++ isa = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL; ++ ++ if(isa && AvFILLp(isa) >= 0) { ++ SV** seqs_ptr; ++ I32 seqs_items; ++ HV* tails = (HV*)sv_2mortal((SV*)newHV()); ++ AV* seqs = (AV*)sv_2mortal((SV*)newAV()); ++ I32 items = AvFILLp(isa) + 1; ++ SV** isa_ptr = AvARRAY(isa); ++ while(items--) { ++ AV* isa_lin; ++ SV* isa_item = *isa_ptr++; ++ HV* isa_item_stash = gv_stashsv(isa_item, FALSE); ++ if(!isa_item_stash) ++ Perl_croak(aTHX_ "Cannot find class %"SVf" for @%s::ISA", isa_item, rootname); ++ isa_lin = mro_linear_c3(isa_item_stash, level + 1); /* recursion */ ++ av_push(seqs, (SV*)av_make(AvFILLp(isa_lin)+1, AvARRAY(isa_lin))); ++ SvREFCNT_dec(isa_lin); ++ } ++ av_push(seqs, (SV*)av_make(AvFILLp(isa)+1, AvARRAY(isa))); ++ ++ seqs_ptr = AvARRAY(seqs); ++ seqs_items = AvFILLp(seqs) + 1; ++ while(seqs_items--) { ++ AV* seq = (AV*)*seqs_ptr++; ++ I32 seq_items = AvFILLp(seq); ++ if(seq_items > 0) { ++ SV** seq_ptr = AvARRAY(seq) + 1; ++ while(seq_items--) { ++ SV* seqitem = *seq_ptr++; + HE* he = hv_fetch_ent(tails, seqitem, 0, 0); + if(!he) { + hv_store_ent(tails, seqitem, newSViv(1), 0); @@ -1131,112 +1097,62 @@ + } + } + } ++ } + -+ if(crisa) { -+ AV* crisa_seq = newAV(); -+ SV** seqptr = AvARRAY(crisa); -+ I32 seqitems = AvFILLp(crisa) + 1; -+ while(seqitems--) { -+ SV* tempsv = *seqptr++; -+ SvREFCNT_inc_simple_void_NN(tempsv); -+ av_push(crisa_seq, tempsv); ++ while(1) { ++ SV* seqhead = NULL; ++ SV* cand = NULL; ++ SV* winner = NULL; ++ SV* val; ++ HE* tail_entry; ++ AV* seq; ++ SV** avptr = AvARRAY(seqs); ++ items = AvFILLp(seqs)+1; ++ while(items--) { ++ SV** svp; ++ seq = (AV*)*avptr++; ++ if(AvFILLp(seq) < 0) continue; ++ svp = av_fetch(seq, 0, 0); ++ seqhead = *svp; ++ if(!winner) { ++ cand = seqhead; ++ if((tail_entry = hv_fetch_ent(tails, cand, 0, 0)) ++ && (val = HeVAL(tail_entry)) ++ && (SvIVx(val) > 0)) ++ continue; ++ winner = newSVsv(cand); ++ av_push(retval, winner); + } ++ if(!sv_cmp(seqhead, winner)) { + -+ seqitems = AvFILLp(crisa_seq); -+ if(seqitems >= 0) av_push(seqs, (SV*)crisa_seq); -+ if(seqitems > 0) { -+ seqptr = AvARRAY(crisa_seq) + 1; -+ while(seqitems--) { -+ SV* seqitem = *(seqptr++); -+ HE* he = hv_fetch_ent(tails, seqitem, 0, 0); -+ if(!he) { -+ hv_store_ent(tails, seqitem, newSViv(1), 0); -+ } -+ else { -+ SV* val = HeVAL(he); -+ sv_inc(val); -+ } -+ } -+ } -+ } ++ /* this is basically shift(@seq) in void context */ ++ SvREFCNT_dec(*AvARRAY(seq)); ++ *AvARRAY(seq) = &PL_sv_undef; ++ AvARRAY(seq) = AvARRAY(seq) + 1; ++ AvMAX(seq)--; ++ AvFILLp(seq)--; + -+ while(1) { -+ SV* seqhead = NULL; -+ SV* cand = NULL; -+ SV* winner = NULL; -+ SV* val; -+ HE* tail_entry; -+ AV* seq; -+ avptr = AvARRAY(seqs); -+ items = AvFILLp(seqs)+1; -+ while(items--) { -+ seq = (AV*)*avptr++; + if(AvFILLp(seq) < 0) continue; + svp = av_fetch(seq, 0, 0); + seqhead = *svp; -+ if(!winner) { -+ cand = seqhead; -+ if((tail_entry = hv_fetch_ent(tails, cand, 0, 0)) -+ && (val = HeVAL(tail_entry)) -+ && SvIVx(val) > 0) -+ continue; -+ winner = cand; -+ SvREFCNT_inc_simple_void_NN(cand); -+ av_push(res, cand); -+ } -+ if(!sv_cmp(seqhead, winner)) { -+ -+ /* this is basically shift(@seq) in void context */ -+ SvREFCNT_dec(*AvARRAY(seq)); -+ *AvARRAY(seq) = &PL_sv_undef; -+ AvARRAY(seq) = AvARRAY(seq) + 1; -+ AvMAX(seq)--; -+ AvFILLp(seq)--; -+ -+ if(AvFILLp(seq) < 0) continue; -+ svp = av_fetch(seq, 0, 0); -+ seqhead = *svp; -+ tail_entry = hv_fetch_ent(tails, seqhead, 0, 0); -+ val = HeVAL(tail_entry); -+ sv_dec(val); -+ } ++ tail_entry = hv_fetch_ent(tails, seqhead, 0, 0); ++ val = HeVAL(tail_entry); ++ sv_dec(val); + } -+ if(!cand) break; -+ if(!winner) Perl_croak(aTHX_ "Inconsistent hierarchy XXX"); + } -+ SvREADONLY_on(res); -+ HvAUX(current_root)->xhv_mro_linear_c3_gen = PL_isa_generation; -+ HvAUX(current_root)->xhv_mro_linear_c3 = res; -+ SvREFCNT_dec(tails); -+ SvREFCNT_dec(seqs); ++ if(!cand) break; ++ if(!winner) ++ Perl_croak(aTHX_ "Inconsistent hierarchy XXX"); + } ++ } + -+ SvREFCNT_dec(recurse_mergeout); -+ SvREFCNT_dec(isv); -+ -+ if(AvFILLp(C3STACK) < 0) { -+ /* clean up our temporaries */ -+ SvREFCNT_dec(C3STACK); -+ SvREFCNT_dec(seen); -+ SvREFCNT_inc_simple_void_NN(res); -+ return res; -+ } ++ SvREADONLY_on(retval); ++ HvAUX(root)->xhv_mro_linear_c3_gen = PL_isa_generation; ++ HvAUX(root)->xhv_mro_linear_c3 = retval; + -+ AV* tempav = (AV*)av_pop(C3STACK); -+ svp = av_fetch(tempav, 0, 0); -+ current_root = (HV*)*svp; -+ svp = av_fetch(tempav, 1, 0); -+ recurse_mergeout = (AV*)*svp; -+ svp = av_fetch(tempav, 2, 0); -+ isv = *svp; -+ SvREFCNT_inc_simple_void_NN(current_root); -+ SvREFCNT_inc_simple_void_NN(recurse_mergeout); -+ SvREFCNT_inc_simple_void_NN(isv); -+ SvREFCNT_dec(tempav); -+ -+ SvREFCNT_inc_simple_void_NN(res); -+ av_push(recurse_mergeout, (SV*)res); -+ } ++ SvREFCNT_inc_simple_void_NN(retval); /* for _aux storage above */ ++ SvREFCNT_inc_simple_void_NN(retval); /* for return to caller */ ++ return retval; +} + +/* @@ -1259,7 +1175,7 @@ + if(!HvAUX(stash)->xhv_mro) { + return mro_linear_dfs(stash, 0); + } else { -+ return mro_linear_c3(stash); ++ return mro_linear_c3(stash, 0); + } +} + @@ -1274,8 +1190,8 @@ + */ === hv.c ================================================================== ---- hv.c (/local/perl-current) (revision 12419) -+++ hv.c (/local/perl-c3) (revision 12419) +--- hv.c (/local/perl-current) (revision 12457) ++++ hv.c (/local/perl-c3) (revision 12457) @@ -1895,6 +1895,11 @@ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ iter->xhv_name = 0; @@ -1290,8 +1206,8 @@ === hv.h ================================================================== ---- hv.h (/local/perl-current) (revision 12419) -+++ hv.h (/local/perl-c3) (revision 12419) +--- hv.h (/local/perl-current) (revision 12457) ++++ hv.h (/local/perl-c3) (revision 12457) @@ -44,6 +44,11 @@ AV *xhv_backreferences; /* back references for weak references */ HE *xhv_eiter; /* current entry of iterator */ @@ -1306,8 +1222,8 @@ /* hash structure: */ === mg.c ================================================================== ---- mg.c (/local/perl-current) (revision 12419) -+++ mg.c (/local/perl-c3) (revision 12419) +--- mg.c (/local/perl-current) (revision 12457) ++++ mg.c (/local/perl-c3) (revision 12457) @@ -1511,6 +1511,7 @@ PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); @@ -1318,9 +1234,9 @@ === intrpvar.h ================================================================== ---- intrpvar.h (/local/perl-current) (revision 12419) -+++ intrpvar.h (/local/perl-c3) (revision 12419) -@@ -560,6 +560,7 @@ +--- intrpvar.h (/local/perl-current) (revision 12457) ++++ intrpvar.h (/local/perl-c3) (revision 12457) +@@ -558,6 +558,7 @@ PERLVARI(Iutf8cache, I8, 1) /* Is the utf8 caching code enabled? */ #endif @@ -1330,8 +1246,8 @@ * (Don't forget to add your variable also to perl_clone()!) === sv.c ================================================================== ---- sv.c (/local/perl-current) (revision 12419) -+++ sv.c (/local/perl-c3) (revision 12419) +--- sv.c (/local/perl-current) (revision 12457) ++++ sv.c (/local/perl-c3) (revision 12457) @@ -10985,6 +10985,7 @@ PL_initav = av_dup_inc(proto_perl->Iinitav, param); @@ -1342,14 +1258,14 @@ PL_forkprocess = proto_perl->Iforkprocess; === embed.fnc ================================================================== ---- embed.fnc (/local/perl-current) (revision 12419) -+++ embed.fnc (/local/perl-c3) (revision 12419) +--- embed.fnc (/local/perl-current) (revision 12457) ++++ embed.fnc (/local/perl-c3) (revision 12457) @@ -278,6 +278,9 @@ Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain Ap |GV* |gv_fetchfile |NN const char* name +ApM |AV* |mro_linear |NN HV* stash -+ApM |AV* |mro_linear_c3 |NN HV* stash ++ApM |AV* |mro_linear_c3 |NN HV* stash|I32 level +ApM |AV* |mro_linear_dfs |NN HV* stash|I32 level Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level @@ -1358,5 +1274,5 @@ Property changes on: ___________________________________________________________________ Name: svk:merge - +2679d79f-d018-0410-a353-0f906ad2929c:/local/perl-current:12418 + +2679d79f-d018-0410-a353-0f906ad2929c:/local/perl-current:12453