Show
Ignore:
Timestamp:
12/03/08 20:56:47 (4 years ago)
Author:
gfx
Message:

fix BUIDLALL/DEMOLISHALL and add buildall/demolishall tests

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Shika/trunk/mro_compat.c

    r25667 r25791  
    1 #define PERL_NO_GET_CONTEXT 
    2 #include <EXTERN.h> 
    3 #include <perl.h> 
    4 #include <XSUB.h> 
    5 #include "ppport.h" 
     1/* 
     2---------------------------------------------------------------------------- 
     3 
     4    mro_compat.h - Provides mro functions for XS 
     5 
     6    Automatically created by Devel::MRO/0.01, running under perl 5.10.0 
     7 
     8    Copyright (c) 2008, Goro Fuji <gfuji(at)cpan.org>. 
     9 
     10    This program is free software; you can redistribute it and/or 
     11    modify it under the same terms as Perl itself. 
     12 
     13---------------------------------------------------------------------------- 
     14 
     15Privides: 
     16        AV*  mro_get_linear_isa(HV* stash) 
     17        UV   mro_get_pkg_gen(HV* stash) 
     18        void mro_method_changed_in(HV* stash) 
     19 
     20    See "perldoc mro" for details. 
     21 
     22 
     23 */ 
    624 
    725#include "mro_compat.h" 
    … …  
    1331AV* 
    1432my_mro_get_linear_isa(pTHX_ HV* const stash){ 
    15         SV* klass; 
    16         SV* isa; 
    1733        GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE); 
    18         AV* av; 
    19         SV* subgen; 
    20         dSP; 
     34        AV* isa; 
     35        SV* gen; 
     36        CV* get_linear_isa; 
    2137 
    2238        if(!isGV(cachegv)) 
    2339                gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE); 
    2440 
    25         av = GvAVn(cachegv); 
     41        isa = GvAVn(cachegv); 
     42        gen = GvSVn(cachegv); 
    2643 
    27 #ifdef GvSVn 
    28         subgen = GvSVn(cachegv); 
    29 #else 
    30         subgen = GvSV(cachegv); 
    31 #endif 
    32  
    33         if(SvIOK(subgen) && SvIVX(subgen) == (IV)PL_sub_generation){ 
    34                 return av; 
     44        if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){ 
     45                return isa; /* returns the cache if available */ 
     46        } 
     47        else{ 
     48                SvREADONLY_off(isa); 
     49                av_clear(isa); 
    3550        } 
    3651 
    37         klass = newSVpv(HvNAME(stash), 0); 
     52        get_linear_isa = get_cv("mro::get_linear_isa", FALSE); 
     53        if(!get_linear_isa){ 
     54                ENTER; 
     55                SAVETMPS; 
    3856 
    39         ENTER; 
    40         SAVETMPS; 
     57                Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs("MRO::Compat"), NULL, NULL); 
     58                get_linear_isa = get_cv("mro::get_linear_isa", TRUE); 
    4159 
    42         PUSHMARK(SP); 
    43         mXPUSHs(klass); 
    44         PUTBACK; 
    45  
    46         /* need MRO::Compat */ 
    47         call_pv("mro::get_linear_isa", G_SCALAR); 
    48  
    49         SPAGAIN; 
    50         isa = POPs; 
    51         PUTBACK; 
    52  
    53         if(SvROK(isa) && SvTYPE(SvRV(isa)) == SVt_PVAV){ 
    54                 sv_setiv(subgen, (IV)PL_sub_generation); 
    55  
    56                 SvSetMagicSV((SV*)cachegv, isa); /*  *glob = [...] */ 
    57         } 
    58         else{ 
    59                 Perl_croak(aTHX_ "mro::get_linear_isa didn't return an ARRAY reference"); 
     60                FREETMPS; 
     61                LEAVE; 
    6062        } 
    6163 
    62         FREETMPS; 
    63         LEAVE; 
     64        { 
     65                SV* avref; 
     66                dSP; 
    6467 
     68                ENTER; 
     69                SAVETMPS; 
     70 
     71                PUSHMARK(SP); 
     72                mXPUSHp(HvNAME(stash), strlen(HvNAME(stash))); 
     73                PUTBACK; 
     74 
     75                call_sv((SV*)get_linear_isa, G_SCALAR); 
     76 
     77                SPAGAIN; 
     78                avref = POPs; 
     79                PUTBACK; 
     80 
     81                if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){ 
     82                        AV* const av  = (AV*)SvRV(avref); 
     83                        I32 const len = AvFILLp(av) + 1; 
     84                        I32 i; 
     85                        sv_setiv(gen, (IV)mro_get_pkg_gen(stash)); 
     86 
     87                        for(i = 0; i < len; i++){ 
     88                                HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE); 
     89                                if(stash) 
     90                                        av_push(isa, newSVpv(HvNAME(stash), 0)); 
     91                        } 
     92                        SvREADONLY_on(isa); 
     93                } 
     94                else{ 
     95                        Perl_croak(aTHX_ "mro::get_linear_isa() didn't return an ARRAY reference"); 
     96                } 
     97 
     98                FREETMPS; 
     99                LEAVE; 
     100        } 
    65101        return GvAV(cachegv); 
    66102} 
    67103 
    68 #endif /* !NEED_MRO_COMPAT */ 
     104 
     105#endif /* !NEED_MOR_COMPAT */