In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/750c2d3dd28995e0efeff01d561e25cd5e1be538?hp=847ded71f84f381516f5a2852e269aa8f2728155>
- Log ----------------------------------------------------------------- commit 750c2d3dd28995e0efeff01d561e25cd5e1be538 Author: Father Chrysostomos <[email protected]> Date: Tue Nov 30 22:36:52 2010 -0800 ++substr $mro'VERSION, -1 M ext/mro/mro.pm commit a5cd004dbd757df2bcf9e17aab6a8ed1272157d7 Author: Father Chrysostomos <[email protected]> Date: Tue Nov 30 22:35:16 2010 -0800 [perl #68654] next::method doesn't see UNIVERSAL This commit makes next::method retry with UNIVERSAL if it reaches the end of the MRO list. M ext/mro/mro.xs M t/mro/next_edgecases.t commit f32becadbe83ee90251793094dc804d84cef87a0 Author: Father Chrysostomos <[email protected]> Date: Tue Nov 30 22:31:41 2010 -0800 Make next_edgecases.t easier to deal with This makes ./perl -Ilib t/mro/next_edgecases.t work and also allows test functions to be called without parentheses. M t/mro/next_edgecases.t ----------------------------------------------------------------------- Summary of changes: ext/mro/mro.pm | 2 +- ext/mro/mro.xs | 14 ++++++++++++++ t/mro/next_edgecases.t | 20 +++++++++++++++++++- 3 files changed, 34 insertions(+), 2 deletions(-) diff --git a/ext/mro/mro.pm b/ext/mro/mro.pm index f8c8a5b..ef47c84 100644 --- a/ext/mro/mro.pm +++ b/ext/mro/mro.pm @@ -12,7 +12,7 @@ use warnings; # mro.pm versions < 1.00 reserved for MRO::Compat # for partial back-compat to 5.[68].x -our $VERSION = '1.05'; +our $VERSION = '1.06'; sub import { mro::set_mro(scalar(caller), $_[1]) if $_[1]; diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs index fb28399..63befa9 100644 --- a/ext/mro/mro.xs +++ b/ext/mro/mro.xs @@ -482,6 +482,7 @@ mro__nextcan(...) const char *hvname; I32 entries; struct mro_meta* selfmeta; + bool seen_univ = FALSE; HV* nmcache; I32 i; PPCODE: @@ -612,6 +613,7 @@ mro__nextcan(...) /* Now search the remainder of the MRO for the same method name as the contextually enclosing method */ + retry: if(entries > 0) { while (entries--) { SV * const linear_sv = *linear_svp++; @@ -631,6 +633,10 @@ mro__nextcan(...) assert(curstash); + if (!seen_univ && SvCUR(linear_sv) == 9 + && strnEQ(SvPV_nolen_const(linear_sv), "UNIVERSAL", 9)) + seen_univ = TRUE; + gvp = (GV**)hv_fetch(curstash, subname, subname_len, 0); if (!gvp) continue; @@ -652,6 +658,14 @@ mro__nextcan(...) } } + if (!seen_univ && (selfstash = gv_stashpvn("UNIVERSAL", 9, 0))) { + linear_av = S_mro_get_linear_isa_c3(aTHX_ selfstash, 0); + linear_svp = AvARRAY(linear_av); + entries = AvFILLp(linear_av) + 1; + seen_univ = TRUE; + goto retry; + } + (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0); if(throw_nomethod) Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname); diff --git a/t/mro/next_edgecases.t b/t/mro/next_edgecases.t index ff3272d..e77ce7b 100644 --- a/t/mro/next_edgecases.t +++ b/t/mro/next_edgecases.t @@ -3,7 +3,9 @@ use strict; use warnings; -require q(./test.pl); plan(tests => 12); +BEGIN { chdir 't'; require q(./test.pl); @INC = qw "../lib lib" } + +plan(tests => 14); { @@ -91,3 +93,19 @@ require q(./test.pl); plan(tests => 12); is($@, '', "->next::can on non-existing package name"); } + +# Test next::method with UNIVERSAL methods +{ + package UNIVERSAL; + sub foo { "foo" } + our @ISA = "a"; + package a; + sub bar { "bar" } + package M; + sub foo { shift->next::method } + sub bar { shift->next::method } + package main; + + is eval { M->foo }, "foo", 'next::method with implicit UNIVERSAL'; + is eval { M->bar }, "bar", 'n::m w/superclass of implicit UNIVERSAL'; +} -- Perl5 Master Repository
