ISA cache problem with blessed stash objects

p5pRT commented 21 years ago

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

Searchable as RT22719$

p5pRT commented 21 years ago

From @scottwalters

Created by @scottwalters

This is a bug report for perl from scott@illogics.org\, generated with the help of perlbug 1.34 running under perl v5.8.0.

-----------------------------------------------------------------

perl -e 'sub Foo::bar { print "hi\n"; } my $a = bless \%{"Foo::"}\, "Foo"; my $code = \&Foo::bar; *Foo::bar = sub { my $this = shift; *{"Foo::this"} = $this; goto &$code;}; $a->bar(); $a->{bar}->();'

Hi\,

I reduced the crasher to the smallest possible sequence of events as I could\, and I'm really surprised that that many elements are required.

In English\, I'm creating an object that is a blessed stash; I'm replacing the sub defined in that stash with a closure; that closure is reading a non-existant argument and then stuffing it into a glob before using the magic goto to go to the method being replaced. The replaced method method is called using the normal OO call syntax\, and then the stash is used as a hash to look up the entry for that method directly\, and it is invoked as a coderef.

$a->{bar}->() alone isn't enough to crash it - the $a->bar() call must precede it. This doesn't happen when *Foo::bar isn't replaced at runtime\, either.

This isn't holding up my work any (I shouldn't be writing code like this in the first place) - I'm just concerned about Safe.pm\, etc. IMHO the only correct behavior given that garbage is not to crash ;)

If this is indeed a real problem\, I'd love to hear a brief explanation of what is happening. Observed this on 5.6.1 on FreeBSD 5\, 5.8.0 on MacPPC NetBSD 1.6\, NetBSD 1.6.1 i386 5.8.0\, NetBSD 1.5.3 i386 5.8.0\, NetBSD 1.6 Alpha 5.8.0. You'd think I'd have better things to do with my time.

Thanks! -scott

Perl Info

``` Flags: category=core severity=low Site configuration information for perl v5.8.0: Configured by phaedrus at Thu Nov 7 03:35:37 PST 2002. Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration: Platform: osname=netbsd, osvers=1.4.3, archname=macppc-netbsd uname='netbsd straylight 1.4.3 netbsd 1.4.3 (generic) #20: sat nov 4 16:42:34 met 2000 he@gravensten.runit.no:usrsrcsysarchmacppccompilegeneric macppc ' config_args='-de' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=y, bincompat5005=undef Compiler: cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include', optimize='-O', cppflags='-fno-strict-aliasing -I/usr/local/include' ccversion='', gccversion='egcs-2.91.60 19981201 (egcs-1.1.1 release)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='cc', ldflags =' -Wl,-rpath,/usr/pkg/lib -Wl,-rpath,/usr/local/lib -L/usr/local/lib' libpth=/usr/local/lib /usr/lib libs=-lgdbm -lm -lc -lposix -lcrypt -lutil perllibs=-lm -lc -lposix -lcrypt -lutil libc=/usr/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-whole-archive -lgcc -Wl,-no-whole-archive -Wl,-E ' cccdlflags='-DPIC -fPIC ', lddlflags='--whole-archive -shared -L/usr/local/lib' Locally applied patches: @INC for perl v5.8.0: /usr/local/lib/perl5/5.8.0/macppc-netbsd /usr/local/lib/perl5/5.8.0 /usr/local/lib/perl5/site_perl/5.8.0/macppc-netbsd /usr/local/lib/perl5/site_perl/5.8.0 /usr/local/lib/perl5/site_perl/5.6.1 /usr/local/lib/perl5/site_perl/5.6.0 /usr/local/lib/perl5/site_perl . Environment for perl v5.8.0: HOME=/home/phaedrus LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH=/home/tgz/mozilla/dist/bin:/usr/home/ingres/lib:/opt/lib LOGDIR (unset) PATH=/bin:/usr/bin:/usr/local/bin:/usr/X11R6/bin:/usr/local/sbin:/home/ingres/bin:/sbin:/usr/sbin:/home/jdk/bin:/usr/local/netpbm:/usr/local/samba/bin:/opt/bin PERL_BADLANG (unset) SHELL=/bin/bash ```

p5pRT commented 21 years ago

From sky@nanisky.com

On Tuesday\, June 17\, 2003\, at 08:57 am\, scott@illogics.org (via RT) wrote:

perl -e 'sub Foo::bar { print "hi\n"; } my $a = bless \%{"Foo::"}\, "Foo"; my $code = \&Foo::bar; *Foo::bar = sub { my $this = shift; *{"Foo::this"} = $this; goto &$code;}; $a->bar(); $a->{bar}->();'

Hi\,

I reduced the crasher to the smallest possible sequence of events as I could\, and I'm really surprised that that many elements are required.

Have you tried this using maint perl? It has some nifty stash cache things that might change the behaviour.

Arthur

p5pRT commented 21 years ago

From @scottwalters

Hi\,

Today\, I fetched Perl 5.9.0 using rsync -avz rsync://ftp.linux.activestate.com/perl-current/ . If I understand correctly\, this is the bleeding edge. The coredumper described below exists in this version (as well as 5.8.0).

Sorry for the slow reply\, and I hope this helps! Thanks!

-scott

On 0\, "A.Bergman (via RT)" \perlbug\-followup@perl\.org wrote:

On Tuesday\, June 17\, 2003\, at 08:57 am\, scott@illogics.org (via RT) wrote:

perl -e 'sub Foo::bar { print "hi\n"; } my $a = bless \%{"Foo::"}\, "Foo"; my $code = \&Foo::bar; *Foo::bar = sub { my $this = shift; *{"Foo::this"} = $this; goto &$code;}; $a->bar(); $a->{bar}->();'

Hi\,

I reduced the crasher to the smallest possible sequence of events as I could\, and I'm really surprised that that many elements are required.

Have you tried this using maint perl? It has some nifty stash cache things that might change the behaviour.

Arthur

p5pRT commented 21 years ago

From @nwc10

On Mon\, Jun 23\, 2003 at 04:12:57PM -0700\, Scott Walters wrote:

Hi\,

Today\, I fetched Perl 5.9.0 using rsync -avz rsync://ftp.linux.activestate.com/perl-current/ . If I understand correctly\, this is the bleeding edge. The coredumper described below exists in this version (as well as 5.8.0).

Sorry for the slow reply\, and I hope this helps! Thanks!

$ valgrind --gdb-attach=yes ./perl -e 'sub Foo::bar { print "hi\n"; } my $a = bless \%{"Foo::"}\, "Foo"; my $code = \&Foo::bar; *Foo::bar = sub { my $this = shift; *{"Foo::this"} = $this; goto &$code;}; $a->bar(); $a->{bar}->();' ==19608== Memcheck\, a.k.a. Valgrind\, a memory error detector for x86-linux. ==19608== Copyright (C) 2002\, and GNU GPL'd\, by Julian Seward. ==19608== Using valgrind-1.9.6\, a program instrumentation system for x86-linux. ==19608== Copyright (C) 2000-2002\, and GNU GPL'd\, by Julian Seward. ==19608== Estimated CPU clock rate is 1530 MHz ==19608== For more details\, rerun with: -v ==19608== hi ==19608== Invalid read of size 1 ==19608== at 0x80D5769: Perl_sv_setsv_flags (sv.c:3675) ==19608== by 0x80C54E4: Perl_pp_sassign (pp_hot.c:105) ==19608== by 0x80AFD41: Perl_runops_debug (dump.c:1430) ==19608== by 0x806259E: S_run_body (perl.c:1585) ==19608== Address 0x8 is not stack'd\, malloc'd or free'd ==19608== ==19608== ---- Attach to GDB ? --- [Return/N/n/Y/y/C/c] ---- y ==19608== starting GDB with cmd: /usr/bin/gdb -nw /proc/19608/exe 19608

(gdb) print *sstr $3 = {sv_any = 0x57e58955\, sv_refcnt = 3968029526\, sv_flags = 59436}

It's this bit of sv.c:

else if (dtype == SVt_PVGV && SvTYPE(SvRV(sstr)) == SVt_PVGV) {

And it looks like sstr is garbage. Quite how it got that way\, or how to fix it\, I don't know.

Nicholas Clark

p5pRT commented 21 years ago

From @iabyn

The coredump reduces to the following simple case:

sub f { my $x = shift; *z = $x; }

f({}); f();

the second call to f() has $x as type RV (due to the previous call)\, but !ROK - due to the undef assignment. sv_setsv_flags() didn't check for ROK in this context.

Patch below.

-- print+qq&$}$"$/$s$\,$*${$}$g$s$@$.$q$\,$:$.$q$^$\,$@$*$~$;$.$q$m&if+map{m\,^\d{0\\,}\,\,${$::{$'}}=chr($"+=$&||1)}q&10m22\,42}6:17*2~2.3@3;^2$g3q/s"&=~m*\d\*.*g

Inline Patch

```diff --- sv.c- Tue Jun 24 12:38:17 2003 +++ sv.c Tue Jun 24 12:39:12 2003 @@ -3673,7 +3673,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi if (dtype < SVt_RV) sv_upgrade(dstr, SVt_RV); else if (dtype == SVt_PVGV && - SvTYPE(SvRV(sstr)) == SVt_PVGV) { + SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) { sstr = SvRV(sstr); if (sstr == dstr) { if (GvIMPORTED(dstr) != GVf_IMPORTED --- t/op/ref.t- Tue Jun 24 12:42:17 2003 +++ t/op/ref.t Tue Jun 24 12:47:37 2003 @@ -5,7 +5,7 @@ @INC = qw(. ../lib); } -print "1..67\n"; +print "1..68\n"; require 'test.pl'; @@ -350,6 +350,14 @@ if ($? != 0) { print "not " }; print "ok ",++$test," - warn called inside UNIVERSAL::DESTROY\n"; + +# bug #22719 + +runperl(prog => 'sub f { my $x = shift; *z = $x; } f({}); f();'); +if ($? != 0) { print "not " }; +print "ok ",++$test," - coredump on typeglob = (SvRV && !SvROK)\n"; + + # test global destruction ++$test; ```

p5pRT commented 21 years ago

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

Perl / perl5