diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-10-10 23:31:55 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-10 23:42:18 -0700 |
| commit | 02cab6748c4f3e4cc55324283a910fa275726a56 (patch) | |
| tree | e397af825c9eb1c24acc381e4ca7893bf505dc9e /ext/XS-APItest/APItest.xs | |
| parent | c145ee241a3cd455c002d4bcfab1e17ba1163c2c (diff) | |
| download | perl-02cab6748c4f3e4cc55324283a910fa275726a56.tar.gz | |
[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.
Diffstat (limited to 'ext/XS-APItest/APItest.xs')
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 4911f9aba2..27c587af58 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1063,11 +1063,23 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) return SvCUR(buf_sv); } +static AV * +myget_linear_isa(pTHX_ HV *stash, U32 level) { + PERL_UNUSED_ARG(level); + GV **gvp = (GV **)hv_fetchs(stash, "ISA", 0); + return gvp && *gvp && GvAV(*gvp) + ? GvAV(*gvp) + : (AV *)sv_2mortal((SV *)newAV()); +} + XS_EXTERNAL(XS_XS__APItest__XSUB_XS_VERSION_undef); XS_EXTERNAL(XS_XS__APItest__XSUB_XS_VERSION_empty); XS_EXTERNAL(XS_XS__APItest__XSUB_XS_APIVERSION_invalid); +static struct mro_alg mymro; + + #include "const-c.inc" MODULE = XS::APItest PACKAGE = XS::APItest @@ -1143,6 +1155,12 @@ BOOT: newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__); newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__); newXS("XS::APItest::XSUB::XS_APIVERSION_invalid", XS_XS__APItest__XSUB_XS_APIVERSION_invalid, __FILE__); + mymro.resolve = myget_linear_isa; + mymro.name = "justinc"; + mymro.length = 7; + mymro.kflags = 0; + mymro.hash = 0; + Perl_mro_register(aTHX_ &mymro); void XS_VERSION_defined(...) |