(resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure) #9054

p5pRT · 2007-10-07T17:03:55Z

Migrated from rt.perl.org#46217 (status was 'resolved')

Searchable as RT46217$

p5pRT · 2007-10-07T17:03:56Z

From @Corion

This is a bug report for perl from corion@cpan.org,
generated with the help of perlbug 1.36 running under perl 5.10.0.

package main;
use strict;

=head1 DESCRIPTION

This test program shows a difference in behaviour
between 5.8.8 and 5.10. Under 5.8.8, the dynamic
wrapping of methods works and the wrapper always
gets called.

Under 5.10, the wrapper only gets called once.
If you remove the ->SUPER:: call at the end
of the test, it works under 5.10. Unfortunately,
removing elements from a class hierarchy is not
always possible.

=cut

use Test::More tests => 4;
use vars qw( %called );

for my $name (1..2) {
%called = ();
my @lines = (1,2);
my $requests = scalar @lines;

# Install the request dumper :
my $unwind;
{ no warnings 'redefine';
my $old_request = \&Dummy::UserAgent::request;
*Dummy::UserAgent::request = sub {
goto &$old_request if $unwind;
$called{wrapper}++;
$old_request->(@_);
};
};
my $agent = Dummy::Mechanize->new();

for my $line (@lines) {
$agent->get($line);
};
is($called{wrapper},$requests,"$requests calls were made to the
wrapper for round $name");
is($called{total},$requests,"$requests calls were made in total for
round $name");

# Release the hook
$unwind++;
};

sub Dummy::UserAgent::new { bless {}, shift };
sub Dummy::UserAgent::request { $main::called{total}++ };

package Dummy::Mechanize;
use strict;
use vars '@ISA';
BEGIN { @ISA = 'Dummy::UserAgent' };
sub get { my $s = shift; $s->request(@_) };

# If you comment out this line, all is well:
sub request { my $s = shift; $s->SUPER::request(@_) };

Flags:
category=core
severity=high

Site configuration information for perl 5.10.0:

Configured by corion at Sat Oct 6 20:19:19 CEST 2007.

Summary of my perl5 (revision 5 version 10 subversion 0 patch 32052)
configuration:
Platform:
osname=linux, osvers=2.6.17-2-k7, archname=i686-linux
uname='linux aliens 2.6.17-2-k7 #1 smp wed sep 13 17:18:46 utc 2006
i686 gnulinux '
config_args='-Dprefix=/opt/perl -des'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -pipe -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2',
cppflags='-fno-strict-aliasing -pipe -I/usr/local/include'
ccversion='', gccversion='4.1.2 20061115 (prerelease) (Debian
4.1.1-21)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
libs=-lnsl -ldl -lm -lcrypt -lutil -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
libc=/lib/libc-2.3.6.so, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.3.6'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib'

Locally applied patches:
DEVEL

@INC for perl 5.10.0:
/opt/perl/lib/5.10.0/i686-linux
/opt/perl/lib/5.10.0
/opt/perl/lib/site_perl/5.10.0/i686-linux
/opt/perl/lib/site_perl/5.10.0
/opt/perl/lib/site_perl/5.8.8
/opt/perl/lib/site_perl/5.8.7
/opt/perl/lib/site_perl
.

Environment for perl 5.10.0:
HOME=/home/corion
LANG=de_DE.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/home/corion/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:/home/corion/bin:/home/corion/bin
PERL_BADLANG (unset)
SHELL=/bin/bash

p5pRT · 2007-10-08T03:37:10Z

From blblack@gmail.com

On 10/7/07, via RT Max Maischein <perlbug-followup@perl.org> wrote:

This test program shows a difference in behaviour
between 5.8.8 and 5.10. Under 5.8.8, the dynamic
wrapping of methods works and the wrapper always
gets called.

Under 5.10, the wrapper only gets called once.
If you remove the ->SUPER:: call at the end
of the test, it works under 5.10. Unfortunately,
removing elements from a class hierarchy is not
always possible.

I think you've found a buggy interaction between SUPER and the new
method caching code.

Recap of SUPER (skip this if you know how it works): When code
invokes a SUPER method (for example, via "Foo->SUPER::bar()",
"Foo::SUPER::bar()", or "$foo_obj->SUPER::bar()"),
gv_fetchmethod_autoload autovivifies an empty package "Foo::SUPER" if
one didn't already exist, and then asks gv_fetchmeth() to resolve the
bar method there. gv_fetchmeth() will return cache entries from this
special package if they exist. Otherwise it looks up the method in
the parents of Foo (ignoring Foo itself), and caches whatever it finds
in the special SUPER package for later cache re-use.

The problem is that the special SUPER package isn't tied into the new
method cache management stuff (mro cache_gen, magical @ISA change
triggers, etc). Cache entries are being created in the SUPER
packages, but they aren't being properly invalidated at the right
times.

There are a few different ways to go about fixing this. This simplest
and most foolproof way would simply be to disable caching SUPER
lookups, but I doubt anyone wants that answer. The most correct
solution is probably to revamp how SUPER lookups work in general, and
use @ISA aliasing (which doesn't yet working right anyways).

I've attached a patch for what I think is a reasonable compromise
approach. In this patch, when the Foo::SUPER stash is autovivified, a
new @Foo::SUPER::ISA (with magic) which contains just one entry for
"Foo" is created. Because of the way SUPER is specially handled in
the fetchmeth functions, this @ISA won't actually get used for
lookups, but it serves to tie FOO::SUPER into the cache management
code in the right way such that its caches are invalidated at the
right times. It also makes the test case in this ticket pass.

What do you guys think?

-- Brandon

p5pRT · 2007-10-08T03:37:10Z

From blblack@gmail.com

supercache.patch

=== embed.fnc
==================================================================
--- embed.fnc	(revision 55697)
+++ embed.fnc	(local)
@@ -1133,6 +1133,7 @@
 
 #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
 s	|void	|gv_init_sv	|NN GV *gv|I32 sv_type
+s	|HV*	|gv_get_super_pkg|NN const char* name|I32 namelen
 s	|HV*	|require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \
 				|NN const char *methpv|const U32 flags
 #endif
=== embed.h
==================================================================
--- embed.h	(revision 55697)
+++ embed.h	(local)
@@ -1123,6 +1123,7 @@
 #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define gv_init_sv		S_gv_init_sv
+#define gv_get_super_pkg	S_gv_get_super_pkg
 #define require_tie_mod		S_require_tie_mod
 #endif
 #endif
@@ -3391,6 +3392,7 @@
 #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define gv_init_sv(a,b)		S_gv_init_sv(aTHX_ a,b)
+#define gv_get_super_pkg(a,b)	S_gv_get_super_pkg(aTHX_ a,b)
 #define require_tie_mod(a,b,c,d,e)	S_require_tie_mod(aTHX_ a,b,c,d,e)
 #endif
 #endif
=== gv.c
==================================================================
--- gv.c	(revision 55697)
+++ gv.c	(local)
@@ -528,6 +528,32 @@
 =cut
 */
 
+STATIC HV*
+S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
+{
+    AV* superisa;
+    GV** gvp;
+    GV* gv;
+    HV* stash;
+
+    stash = gv_stashpvn(name, namelen, 0);
+    if(stash) return stash;
+
+    /* If we must create it, give it an @ISA array containing
+       the real package this SUPER is for, so that it's tied
+       into the cache invalidation code correctly */
+    stash = gv_stashpvn(name, namelen, GV_ADD);
+    gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
+    gv = *gvp;
+    gv_init(gv, stash, "ISA", 3, TRUE);
+    superisa = GvAVn(gv);
+    GvMULTI_on(gv);
+    sv_magic((SV*)superisa, (SV*)gv, PERL_MAGIC_isa, NULL, 0);
+    av_push(superisa, newSVpv(CopSTASHPV(PL_curcop), 0));
+
+    return stash;
+}
+
 GV *
 Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
@@ -556,7 +582,7 @@
 	    SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
 						  CopSTASHPV(PL_curcop)));
 	    /* __PACKAGE__::SUPER stash should be autovivified */
-	    stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), GV_ADD);
+	    stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr));
 	    DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
 			 origname, HvNAME_get(stash), name) );
 	}
@@ -569,7 +595,7 @@
 	    if (!stash && (nsplit - origname) >= 7 &&
 		strnEQ(nsplit - 7, "::SUPER", 7) &&
 		gv_stashpvn(origname, nsplit - origname - 7, 0))
-	      stash = gv_stashpvn(origname, nsplit - origname, GV_ADD);
+	      stash = gv_get_super_pkg(origname, nsplit - origname);
 	}
 	ostash = stash;
     }
=== proto.h
==================================================================
--- proto.h	(revision 55697)
+++ proto.h	(local)
@@ -3009,6 +3009,9 @@
 STATIC void	S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
 			__attribute__nonnull__(pTHX_1);
 
+STATIC HV*	S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
+			__attribute__nonnull__(pTHX_1);
+
 STATIC HV*	S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv, const U32 flags)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)

p5pRT · 2007-10-08T03:37:11Z

The RT System itself - Status changed from 'new' to 'open'

p5pRT · 2007-10-08T09:27:53Z

From @rgs

On 08/10/2007, Brandon Black <blblack@gmail.com> wrote:

I've attached a patch for what I think is a reasonable compromise
approach. In this patch, when the Foo::SUPER stash is autovivified, a
new @Foo::SUPER::ISA (with magic) which contains just one entry for
"Foo" is created. Because of the way SUPER is specially handled in
the fetchmeth functions, this @ISA won't actually get used for
lookups, but it serves to tie FOO::SUPER into the cache management
code in the right way such that its caches are invalidated at the

Sounds like something not too expensive, performance-wise. Thanks,
applied as #32065.

right times. It also makes the test case in this ticket pass.

Maybe we could get a regression test for this, too ? :)

p5pRT · 2007-10-08T10:27:24Z

@rgs - Status changed from 'open' to 'resolved'

p5pRT · 2007-10-08T13:55:30Z

From blblack@gmail.com

On 10/8/07, Rafael Garcia-Suarez <rgarciasuarez@gmail.com> wrote:

On 08/10/2007, Brandon Black <blblack@gmail.com> wrote:

I've attached a patch for what I think is a reasonable compromise
Sounds like something not too expensive, performance-wise. Thanks,
applied as #32065.
right times. It also makes the test case in this ticket pass.
Maybe we could get a regression test for this, too ? :)

Here's three new tests in t/mro/basic.t. The last two fail without 32065.

-- Brandon

p5pRT · 2007-10-08T13:55:30Z

From blblack@gmail.com

supercache_tests.patch

=== t/mro/basic.t
==================================================================
--- t/mro/basic.t	(revision 55697)
+++ t/mro/basic.t	(local)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 35);
+require q(./test.pl); plan(tests => 38);
 
 {
     package MRO_A;
@@ -190,3 +190,31 @@
     }
 }
 
+# Check that SUPER caches get invalidated correctly
+{
+    {
+        package SUPERTEST;
+        sub new { bless {} => shift }
+        sub foo { $_[1]+1 }
+
+        package SUPERTEST::MID;
+        our @ISA = 'SUPERTEST';
+
+        package SUPERTEST::KID;
+        our @ISA = 'SUPERTEST::MID';
+        sub foo { my $s = shift; $s->SUPER::foo(@_) }
+
+        package SUPERTEST::REBASE;
+        sub foo { $_[1]+3 }
+    }
+
+    my $stk_obj = SUPERTEST::KID->new();
+    is($stk_obj->foo(1), 2);
+    { no warnings 'redefine';
+      *SUPERTEST::foo = sub { $_[1]+2 };
+    }
+    is($stk_obj->foo(2), 4);
+    @SUPERTEST::MID::ISA = 'SUPERTEST::REBASE';
+    is($stk_obj->foo(3), 6);
+}
+

p5pRT · 2007-10-09T09:24:37Z

From @rgs

On 08/10/2007, Brandon Black <blblack@gmail.com> wrote:

Here's three new tests in t/mro/basic.t. The last two fail without 32065.

Thanks, applied.

p5pRT closed this as completed Oct 8, 2007

p5pRT added Severity High distro-Linux type-core labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

(resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure) #9054

(resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure) #9054

p5pRT commented Oct 7, 2007

p5pRT commented Oct 7, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

p5pRT commented Oct 9, 2007

(resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure) #9054

(resent) Typeglobs vs. SUPER:: (Hook::LexWrap failure) #9054

Comments

p5pRT commented Oct 7, 2007

p5pRT commented Oct 7, 2007

From @Corion

p5pRT commented Oct 8, 2007

From blblack@gmail.com

p5pRT commented Oct 8, 2007

From blblack@gmail.com

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

From @rgs

p5pRT commented Oct 8, 2007

p5pRT commented Oct 8, 2007

From blblack@gmail.com

p5pRT commented Oct 8, 2007

From blblack@gmail.com

p5pRT commented Oct 9, 2007

From @rgs