search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.94k stars 554 forks source link

*DESTROY = sub {} at runtime #8946

Closed p5pRT closed 15 years ago

p5pRT commented 17 years ago

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

Searchable as RT43357$

p5pRT commented 17 years ago

From @cpansprout

In perl 5.8.8 and 5.9.4\, I can create a DESTROY method at run-time
after an object has been blessed into the class in question​:

#!/usr/bin/perl -l

bless[];

*DESTROY = sub { print "Aaaaaaah!" };

$obj = bless[1];

print "Before undef"; undef $obj; print "After undef"; __END__

$ perl5.8.8 test Before undef Aaaaaaah! After undef

5.9.5 ignores the DESTROY method​:

$ perl5.9.5 test Before undef After undef

If I remove the 'bless[];' line\, it gives me the same output as 5.8.8
(and 5.9.4).

This was broken at least as early as #31224. It is still broken in
#31441.

Flags​:   category=core   severity=low

This perlbug was built using Perl 5.9.5 - Thu Jun 21 15​:03​:24 PDT 2007 It is being executed now by Perl 5.9.5 - Tue May 15 14​:11​:42 PDT 2007.

Site configuration information for perl 5.9.5​:

Configured by neo at Tue May 15 14​:11​:42 PDT 2007.

Summary of my perl5 (revision 5 version 9 subversion 5 patch 31224)
configuration​:   Platform​:   osname=darwin\, osvers=8.8.0\, archname=darwin-2level   uname='darwin treebeard.local 8.8.0 darwin kernel version 8.8.0​:
fri sep 8 17​:18​:57 pdt 2006; root​:xnu-792.12.6.obj~1release_ppc power
macintosh powerpc '   config_args='-de -Dusedevel'   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-common -DPERL_DARWIN -no-cpp-precomp - fno-strict-aliasing -pipe -I/usr/local/include'\,   optimize='-O3'\,   cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp- precomp -fno-strict-aliasing -pipe -I/usr/local/include'   ccversion=''\, gccversion='4.0.0 20041026 (Apple Computer\, Inc.
build 4061)'\, gccosandvers='darwin8'   intsize=4\, longsize=4\, ptrsize=4\, doublesize=8\, byteorder=4321   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=16   ivtype='long'\, ivsize=4\, nvtype='double'\, nvsize=8\,
Off_t='off_t'\, lseeksize=8   alignbytes=8\, prototype=define   Linker and Libraries​:   ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc'\, ldflags =' -L/usr/ local/lib'   libpth=/usr/local/lib /usr/lib   libs=-ldbm -ldl -lm -lc   perllibs=-ldl -lm -lc   libc=/usr/lib/libc.dylib\, so=dylib\, useshrplib=false\,
libperl=libperl.a   gnulibc_version=''   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=bundle\, d_dlsymun=undef\, ccdlflags=' '   cccdlflags=' '\, lddlflags=' -bundle -undefined dynamic_lookup -L/ usr/local/lib'

Locally applied patches​:   DEVEL

@​INC for perl 5.9.5​:   /usr/local/lib/perl5/5.9.5/darwin-2level   /usr/local/lib/perl5/5.9.5   /usr/local/lib/perl5/site_perl/5.9.5/darwin-2level   /usr/local/lib/perl5/site_perl/5.9.5   /usr/local/lib/perl5/site_perl   .

Environment for perl 5.9.5​:   DYLD_LIBRARY_PATH (unset)   HOME=/Users/neo   LANG (unset)   LANGUAGE (unset)   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/bin​:/sbin​:/usr/bin​:/usr/sbin​:/usr/TeX/bin/powerpc- darwin6.8​:/usr/local/bin   PERL_BADLANG (unset)   SHELL=/bin/bash

p5pRT commented 17 years ago

From @rurban

On Sat Jun 23 18​:30​:23 2007\, sprout \<!-- x --> at cpan.org wrote​:

5.9.5 ignores the DESTROY method This was broken at least as early as #31224. It is still broken in
#31441.

This breaks Class​::Inner in blead.

See http​://www.nntp.perl.org/group/perl.cpan.testers/2007/05/msg480715.html -- Reini Urban

p5pRT commented 17 years ago

From @rurban

Father Chrysostomos (via RT) schrieb​:

# New Ticket Created by Father Chrysostomos # Please include the string​: [perl #43357] # in the subject line of all future correspondence about this issue. # \<URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=43357 >

In perl 5.8.8 and 5.9.4\, I can create a DESTROY method at run-time
after an object has been blessed into the class in question​:

#!/usr/bin/perl -l

bless[];

*DESTROY = sub { print "Aaaaaaah!" };

$obj = bless[1];

print "Before undef"; undef $obj; print "After undef"; __END__

$ perl5.8.8 test Before undef Aaaaaaah! After undef

5.9.5 ignores the DESTROY method​:

$ perl5.9.5 test Before undef After undef

If I remove the 'bless[];' line\, it gives me the same output as 5.8.8
(and 5.9.4).

This was broken at least as early as #31224. It is still broken in
#31441.

This breaks Class​::Inline on blead btw. which a lot of modules depend on. -- Reini Urban

p5pRT commented 17 years ago

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

p5pRT commented 17 years ago

From @andk

On Sun\, 24 Jun 2007 19​:46​:19 +0200\, Reini Urban \rurban@&#8203;x\-ray\.at said​:

  > Father Chrysostomos (via RT) schrieb​:

# New Ticket Created by Father Chrysostomos # Please include the string​: [perl #43357] # in the subject line of all future correspondence about this issue. # \<URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=43357 >

In perl 5.8.8 and 5.9.4\, I can create a DESTROY method at run-time after an object has been blessed into the class in question​:

#!/usr/bin/perl -l

bless[];

*DESTROY = sub { print "Aaaaaaah!" };

$obj = bless[1];

print "Before undef"; undef $obj; print "After undef"; __END__

$ perl5.8.8 test Before undef Aaaaaaah! After undef

5.9.5 ignores the DESTROY method​:

$ perl5.9.5 test Before undef After undef

If I remove the 'bless[];' line\, it gives me the same output as 5.8.8 (and 5.9.4).

This was broken at least as early as #31224. It is still broken in #31441.

  > This breaks Class​::Inline on blead btw. which a lot of modules depend on.

I think you meant Class​::Inner.

In any case binary search reveals it was patch 30980 which broke the above example and Class​::Inner.

  Change 30980 by rgs@​stcosmo on 2007/04/19 14​:48​:20

  Subject​: Re​: new C3 MRO patch   From​: "Brandon Black" \blblack@&#8203;gmail\.com   Date​: Tue\, 17 Apr 2007 13​:14​:36 -0500   Message-ID​: \84621a60704171114k29b0460el5b08ce5185d55ed5@&#8203;mail\.gmail\.com

Hope this helps\, -- andreas

p5pRT commented 17 years ago

From blblack@gmail.com

In any case binary search reveals it was patch 30980 which broke the above example and Class​::Inner.

Change 30980 by rgs@&#8203;stcosmo on 2007/04/19 14&#8203;:48&#8203;:20

    Subject&#8203;: Re&#8203;: new C3 MRO patch
    From&#8203;: "Brandon Black" \<blblack@&#8203;gmail\.com>
    Date&#8203;: Tue\, 17 Apr 2007 13&#8203;:14&#8203;:36 \-0500
    Message\-ID&#8203;: \<84621a60704171114k29b0460el5b08ce5185d55ed5@&#8203;mail\.gmail\.com>

It has something to do with amagic_generation and DESTROY being a special case of overload magic and all of those things\, I'm still hunting around for the right fix.

-- Brandon

p5pRT commented 17 years ago

From @cpansprout

On Sun Jun 24 14​:30​:06 2007\, andreas.koenig.7os6VVqR \<!-- x --> at
mind.de wrote​:

On Sun\, 24 Jun 2007 19​:46​:19 +0200\, Reini Urban \<rurban@​x- ray.at> said​:

Father Chrysostomos (via RT) schrieb​: ...

#!/usr/bin/perl -l

bless[];

*DESTROY = sub { print "Aaaaaaah!" };

$obj = bless[1];

print "Before undef"; undef $obj; print "After undef"; __END__

$ perl5.8.8 test Before undef Aaaaaaah! After undef

5.9.5 ignores the DESTROY method​:

$ perl5.9.5 test Before undef After undef

If I remove the 'bless[];' line\, it gives me the same output as 5.8.8 (and 5.9.4).

...

This breaks Class​::Inline on blead btw. which a lot of modules depend on.

I think you meant Class​::Inner.

Though this may be another manifestation of the same bug\,
Class​::Inner triggers it differently. In effect it does something
like this​:

package Super; # make sure it exists package Thing; @​ISA = 'Super'; bless []; delete $Thing​::{ISA};

After which Thing->isa('Super') returns true (false in 5.8.8). This
causes Class​::Inner's test 13 to fail.

*ISA = []; will also fail to remove the inheritance.

But if you assign to the array (not the glob) as in @​ISA = () or if
you delete the package (delete $​::{'Thing​::'})--something that
Class​::Inner fails to do--\, it does remove the inheritance.

p5pRT commented 17 years ago

From blblack@gmail.com

On 6/26/07\, Father Chrysostomos \sprout@&#8203;cpan\.org wrote​:

On Sun Jun 24 14​:30​:06 2007\, andreas.koenig.7os6VVqR \<!-- x --> at mind.de wrote​:

On Sun\, 24 Jun 2007 19​:46​:19 +0200\, Reini Urban \<rurban@​x- ray.at> said​:

Father Chrysostomos (via RT) schrieb​: ...

#!/usr/bin/perl -l

bless[];

*DESTROY = sub { print "Aaaaaaah!" };

$obj = bless[1];

print "Before undef"; undef $obj; print "After undef"; __END__

$ perl5.8.8 test Before undef Aaaaaaah! After undef

5.9.5 ignores the DESTROY method​:

$ perl5.9.5 test Before undef After undef

If I remove the 'bless[];' line\, it gives me the same output as 5.8.8 (and 5.9.4).

...

This breaks Class​::Inline on blead btw. which a lot of modules depend on.

I think you meant Class​::Inner.

Though this may be another manifestation of the same bug\, Class​::Inner triggers it differently. In effect it does something like this​:

package Super; # make sure it exists package Thing; @​ISA = 'Super'; bless []; delete $Thing​::{ISA};

After which Thing->isa('Super') returns true (false in 5.8.8). This causes Class​::Inner's test 13 to fail.

*ISA = []; will also fail to remove the inheritance.

But if you assign to the array (not the glob) as in @​ISA = () or if you delete the package (delete $​::{'Thing​::'})--something that Class​::Inner fails to do--\, it does remove the inheritance.

Yeah I ran into this after I fixed the DESTROY issue locally. I'm still cleaning up some patches and tests for all of this (DESTROY\, as well as undef @​Foo​::ISA and undef *Foo​::ISA).

-- Brandon

p5pRT commented 17 years ago

From @rgs

On 26/06/07\, Brandon Black \blblack@&#8203;gmail\.com wrote​:

An update and a couple of patches​:

The DESTROY problem itself was relatively trivial to fix. DESTROY is implemented via overloading magic ("amagic")\, and effectively the amagic table acts as an extra layer of method caching. Therefore\, it needed to compare on not just cache_gen\, but also pkg_gen. That's in "destroy.patch" attached here\, with tests.

Class​::Inner is also showing yet a different issue\, which is that the mro-calculating magic isn't getting triggered on "undef @​Foo​::ISA" and "undef *Foo​::ISA". The reason for this is basically that av.c​:av_undef wasn't honoring an array's mg_clear magic. We had clear magic set on the ISA arrays\, but it just wasn't getting called. Contrast this to hv.c​:hv_undef()\, where we actually are calling mg_clear magic on magical hashes. The attached "mgclear_av.patch" puts in the array mg_clear magic in the same manner as the exiting hash support. This fixes "undef @​Foo​::ISA"\, and tests for that are included.

The mgclear fix above *should* have also fixed "undef *Foo​::ISA"\, but it didn't. In the general case\, "undef *Foo" does gp_free on *Foo\, which will (through some levels of indirection) eventually call av_undef on any @​Foo that might exist\, assuming there were no other oustanding references to @​Foo (refcnt went to zero).

Thanks\, applied as 31472 and 31473.

p5pRT commented 17 years ago

From @lizmat

At 11​:10 AM -0500 6/26/07\, Brandon Black wrote​:

An update and a couple of patches​:

The DESTROY problem itself was relatively trivial to fix. DESTROY is implemented via overloading magic ("amagic")\, and effectively the amagic table acts as an extra layer of method caching. Therefore\, it needed to compare on not just cache_gen\, but also pkg_gen. That's in "destroy.patch" attached here\, with tests.

Class​::Inner is also showing yet a different issue\, which is that the mro-calculating magic isn't getting triggered on "undef @​Foo​::ISA" and "undef *Foo​::ISA". The reason for this is basically that av.c​:av_undef wasn't honoring an array's mg_clear magic. We had clear magic set on the ISA arrays\, but it just wasn't getting called. Contrast this to hv.c​:hv_undef()\, where we actually are calling mg_clear magic on magical hashes. The attached "mgclear_av.patch" puts in the array mg_clear magic in the same manner as the exiting hash support. This fixes "undef @​Foo​::ISA"\, and tests for that are included.

The mgclear fix above *should* have also fixed "undef *Foo​::ISA"\, but it didn't. In the general case\, "undef *Foo" does gp_free on *Foo\, which will (through some levels of indirection) eventually call av_undef on any @​Foo that might exist\, assuming there were no other oustanding references to @​Foo (refcnt went to zero).

However\, there's something fishy going on with @​ISA arrays in particular\, that they seem to have an artificially high refcount (1 higher than I would expect it to be)\, so the av_undef isn't being called in this case. As far as I can tell the underlying av* for the @​ISA is just being leaked at that point. I haven't finished investigating this. Once I find the source of the extra refcnt on @​ISA's a fix for "undef *Foo​::ISA" should be clearer.

-- Brandon

Content-Type​: application/octet-stream; name=destroy.patch X-Attachment-Id​: f_f3eke7zv Content-Disposition​: attachment; filename="destroy.patch"

Attachment converted​: Lizymac​:destroy.patch ( / ) (0057500C) Content-Type​: application/octet-stream; name=mgclear_av.patch X-Attachment-Id​: f_f3ekeo2b Content-Disposition​: attachment; filename="mgclear_av.patch"

Attachment converted​: Lizymac​:mgclear_av.patch ( / ) (0057500D)

p5pRT commented 17 years ago

From blblack@gmail.com

An update and a couple of patches​:

The DESTROY problem itself was relatively trivial to fix. DESTROY is implemented via overloading magic ("amagic")\, and effectively the amagic table acts as an extra layer of method caching. Therefore\, it needed to compare on not just cache_gen\, but also pkg_gen. That's in "destroy.patch" attached here\, with tests.

Class​::Inner is also showing yet a different issue\, which is that the mro-calculating magic isn't getting triggered on "undef @​Foo​::ISA" and "undef *Foo​::ISA". The reason for this is basically that av.c​:av_undef wasn't honoring an array's mg_clear magic. We had clear magic set on the ISA arrays\, but it just wasn't getting called. Contrast this to hv.c​:hv_undef()\, where we actually are calling mg_clear magic on magical hashes. The attached "mgclear_av.patch" puts in the array mg_clear magic in the same manner as the exiting hash support. This fixes "undef @​Foo​::ISA"\, and tests for that are included.

The mgclear fix above *should* have also fixed "undef *Foo​::ISA"\, but it didn't. In the general case\, "undef *Foo" does gp_free on *Foo\, which will (through some levels of indirection) eventually call av_undef on any @​Foo that might exist\, assuming there were no other oustanding references to @​Foo (refcnt went to zero).

However\, there's something fishy going on with @​ISA arrays in particular\, that they seem to have an artificially high refcount (1 higher than I would expect it to be)\, so the av_undef isn't being called in this case. As far as I can tell the underlying av* for the @​ISA is just being leaked at that point. I haven't finished investigating this. Once I find the source of the extra refcnt on @​ISA's a fix for "undef *Foo​::ISA" should be clearer.

-- Brandon

p5pRT commented 17 years ago

From blblack@gmail.com

destroy.patch ```diff === gv.c ================================================================== --- gv.c (revision 35102) +++ gv.c (local) @@ -1509,9 +1509,10 @@ dVAR; MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); AMT amt; + const struct mro_meta* stash_meta = HvMROMETA(stash); U32 newgen; - newgen = PL_sub_generation + HvMROMETA(stash)->cache_gen; + newgen = PL_sub_generation + stash_meta->pkg_gen + stash_meta->cache_gen; if (mg) { const AMT * const amtp = (AMT*)mg->mg_ptr; if (amtp->was_ok_am == PL_amagic_generation @@ -1638,11 +1639,13 @@ MAGIC *mg; AMT *amtp; U32 newgen; + struct mro_meta* stash_meta; if (!stash || !HvNAME_get(stash)) return NULL; - newgen = PL_sub_generation + HvMROMETA(stash)->cache_gen; + stash_meta = HvMROMETA(stash); + newgen = PL_sub_generation + stash_meta->pkg_gen + stash_meta->cache_gen; mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); if (!mg) { === t/mro/basic.t ================================================================== --- t/mro/basic.t (revision 35102) +++ t/mro/basic.t (local) @@ -3,7 +3,7 @@ use strict; use warnings; -require q(./test.pl); plan(tests => 12); +require q(./test.pl); plan(tests => 18); { package MRO_A; @@ -69,3 +69,59 @@ # XXX TODO (when there's a way to backtrack through a glob's aliases) # push(@MRO_M::ISA, 'MRO_TestOtherBase'); # is(eval { MRO_N->testfunctwo() }, 321); + +# Simple DESTROY Baseline +{ + my $x = 0; + my $obj; + + { + package DESTROY_MRO_Baseline; + sub new { bless {} => shift } + sub DESTROY { $x++ } + + package DESTROY_MRO_Baseline_Child; + our @ISA = qw/DESTROY_MRO_Baseline/; + } + + $obj = DESTROY_MRO_Baseline->new(); + undef $obj; + is($x, 1); + + $obj = DESTROY_MRO_Baseline_Child->new(); + undef $obj; + is($x, 2); +} + +# Dynamic DESTROY +{ + my $x = 0; + my $obj; + + { + package DESTROY_MRO_Dynamic; + sub new { bless {} => shift } + + package DESTROY_MRO_Dynamic_Child; + our @ISA = qw/DESTROY_MRO_Dynamic/; + } + + $obj = DESTROY_MRO_Dynamic->new(); + undef $obj; + is($x, 0); + + $obj = DESTROY_MRO_Dynamic_Child->new(); + undef $obj; + is($x, 0); + + no warnings 'once'; + *DESTROY_MRO_Dynamic::DESTROY = sub { $x++ }; + + $obj = DESTROY_MRO_Dynamic->new(); + undef $obj; + is($x, 1); + + $obj = DESTROY_MRO_Dynamic_Child->new(); + undef $obj; + is($x, 2); +} ```
p5pRT commented 17 years ago

From blblack@gmail.com

mgclear_av.patch ```diff === av.c ================================================================== --- av.c (revision 35103) +++ av.c (local) @@ -469,17 +469,20 @@ /* Give any tie a chance to cleanup first */ if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) - av_fill(av, -1); /* mg_clear() ? */ + av_fill(av, -1); if (AvREAL(av)) { register I32 key = AvFILLp(av) + 1; while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } + Safefree(AvALLOC(av)); AvALLOC(av) = NULL; AvARRAY(av) = NULL; AvMAX(av) = AvFILLp(av) = -1; + + if(SvRMAGICAL(av)) mg_clear((SV*)av); } /* === t/mro/basic.t ================================================================== --- t/mro/basic.t (revision 35103) +++ t/mro/basic.t (local) @@ -3,7 +3,7 @@ use strict; use warnings; -require q(./test.pl); plan(tests => 18); +require q(./test.pl); plan(tests => 21); { package MRO_A; @@ -125,3 +125,22 @@ undef $obj; is($x, 2); } + +# clearing @ISA in different ways +{ + no warnings 'uninitialized'; + { + package ISACLEAR; + our @ISA = qw/XX YY ZZ/; + } + # baseline + ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX YY ZZ/])); + + # this looks dumb, but it preserves existing behavior for compatibility + # (undefined @ISA elements treated as "main") + $ISACLEAR::ISA[1] = undef; + ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX main ZZ/])); + + undef @ISACLEAR::ISA; + ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR/])); +} ```
p5pRT commented 17 years ago

From blblack@gmail.com

On 6/26/07\, Brandon Black \blblack@&#8203;gmail\.com wrote​:

The mgclear fix above *should* have also fixed "undef *Foo​::ISA"\, but it didn't. In the general case\, "undef *Foo" does gp_free on *Foo\, which will (through some levels of indirection) eventually call av_undef on any @​Foo that might exist\, assuming there were no other oustanding references to @​Foo (refcnt went to zero).

However\, there's something fishy going on with @​ISA arrays in particular\, that they seem to have an artificially high refcount (1 higher than I would expect it to be)\, so the av_undef isn't being called in this case. As far as I can tell the underlying av* for the @​ISA is just being leaked at that point. I haven't finished investigating this. Once I find the source of the extra refcnt on @​ISA's a fix for "undef *Foo​::ISA" should be clearer.

Well\, the refcnt thing was easy enough to sort out\, it was related to the arylen magic and the stacking of multiple magics. There was a another deeper issue I ran into looking at this though. Basically\, anytime you truly undefine a package's @​ISA\, you've really screwed method caching/resolution\, inheritance\, etc for that package for the lifetime of the interpreter. This isn't new\, it's just even more obvious now. The source of the issue is that the special "setisa" magic is only applied to an @​ISA array at parse time\, not runtime. Even older Perls rely on this magic to increment PL_sub_generation. So in this example ...

@​Foo​::ISA = qw/A B/; undef *Foo​::ISA\, @​Foo​::ISA = qw/C D/;

... regardless of Perl version\, you've just permanently made method resolution buggy for that package\, because the "new" @​Foo​::ISA has no setisa magic\, and therefore depending on the surrounding code\, from this point forward the method cache entries for Foo could be from any version of its @​ISA\, not necessarily the latest one.

We could probably paper over that issue by having a pp_aassign hook that checks for arrays named ISA in any package that don't have any magic\, and re-setting the magic there. I'm not sure if it's a good idea (perf-wise) to be putting a string comparison there though\, and also pp_assign doesn't currently really have any explicit knowledge about the real array it might be assigning to.

The attached patch fixes the Class​::Inner case (and other related ones) in the sense that the mro code really believes that @​ISA is empty when you destroy it any manner of oddball way\, like undef *Foo​::ISA\, delete $Foo​::{ISA}\, etc\, but it doesn't address the fact that the package is kinda screwed from that point forward as detailed above.

-- Brandon

p5pRT commented 17 years ago

From blblack@gmail.com

isaundef.patch ```diff === embed.fnc ================================================================== --- embed.fnc (revision 35104) +++ embed.fnc (local) @@ -455,6 +455,7 @@ p |int |magic_setfm |NN SV* sv|NN MAGIC* mg dp |int |magic_sethint |NN SV* sv|NN MAGIC* mg p |int |magic_setisa |NN SV* sv|NN MAGIC* mg +p |int |magic_freeisa |NN SV* sv|NN MAGIC* mg p |int |magic_setglob |NN SV* sv|NN MAGIC* mg p |int |magic_setmglob |NN SV* sv|NN MAGIC* mg p |int |magic_setnkeys |NN SV* sv|NN MAGIC* mg === embed.h ================================================================== --- embed.h (revision 35104) +++ embed.h (local) @@ -441,6 +441,7 @@ #define magic_setfm Perl_magic_setfm #define magic_sethint Perl_magic_sethint #define magic_setisa Perl_magic_setisa +#define magic_freeisa Perl_magic_freeisa #define magic_setglob Perl_magic_setglob #define magic_setmglob Perl_magic_setmglob #define magic_setnkeys Perl_magic_setnkeys @@ -2731,6 +2732,7 @@ #define magic_setfm(a,b) Perl_magic_setfm(aTHX_ a,b) #define magic_sethint(a,b) Perl_magic_sethint(aTHX_ a,b) #define magic_setisa(a,b) Perl_magic_setisa(aTHX_ a,b) +#define magic_freeisa(a,b) Perl_magic_freeisa(aTHX_ a,b) #define magic_setglob(a,b) Perl_magic_setglob(aTHX_ a,b) #define magic_setmglob(a,b) Perl_magic_setmglob(aTHX_ a,b) #define magic_setnkeys(a,b) Perl_magic_setnkeys(aTHX_ a,b) === hv.c ================================================================== --- hv.c (revision 35104) +++ hv.c (local) @@ -1518,12 +1518,19 @@ { dVAR; SV *val; + I32 isa_changing = 0; if (!entry) return; val = HeVAL(entry); - if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv)) - mro_method_changed_in(hv); /* deletion of method from stash */ + + if(HvNAME_get(hv) && val && isGV(val)) { + if(GvCVu((GV*)val)) + mro_method_changed_in(hv); /* deletion of method from stash */ + else if(GvAV((GV*)val) && strEQ(GvNAME((GV*)val), "ISA")) + isa_changing = 1; + } + SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); @@ -1534,6 +1541,8 @@ else Safefree(HeKEY_hek(entry)); del_HE(entry); + + if(isa_changing) mro_isa_changed_in(hv); /* deletion of @ISA from stash */ } void @@ -1844,8 +1853,21 @@ DEBUG_A(Perl_hv_assert(aTHX_ hv)); xhv = (XPVHV*)SvANY(hv); - if ((name = HvNAME_get(hv)) && !PL_dirty) + /* If it's a stash, undef the @ISA and call + mro_isa_changed_in before proceeding with + the rest of the destruction */ + if ((name = HvNAME_get(hv)) && !PL_dirty) { + GV** gvp; + GV* gv; + AV* isa; + + gvp = (GV**)hv_fetchs(hv, "ISA", FALSE); + gv = gvp ? *gvp : NULL; + isa = (gv && isGV_with_GP(gv)) ? GvAV(gv) : NULL; + + if(isa) av_undef(isa); mro_isa_changed_in(hv); + } hfreeentries(hv); if (name) { === mg.c ================================================================== --- mg.c (revision 35104) +++ mg.c (local) @@ -1541,6 +1541,26 @@ return 0; } +int Perl_magic_freeisa(pTHX_ SV *sv, MAGIC *mg) +{ + dVAR; + GV** gvp; + GV* gv; + AV* isa; + + PERL_UNUSED_ARG(sv); + + if(PL_dirty) return 0; + + gvp = (GV**)hv_fetchs(GvSTASH((GV*)mg->mg_obj), "ISA", FALSE); + gv = gvp ? *gvp : NULL; + isa = (gv && isGV_with_GP(gv)) ? GvAV(gv) : NULL; + + if(isa) av_undef(isa); + + return 0; +} + int Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg) { === mro.c ================================================================== --- mro.c (revision 35104) +++ mro.c (local) @@ -448,9 +448,11 @@ bool is_universal; struct mro_meta * meta; - const char * const stashname = HvNAME_get(stash); - const STRLEN stashname_len = HvNAMELEN_get(stash); + const char * const stashname = stash ? HvNAME_get(stash) : NULL; + const STRLEN stashname_len = stash ? HvNAMELEN_get(stash) : 0; + if(!stash) return; + if(!stashname) Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table"); === perl.h ================================================================== --- perl.h (revision 35104) +++ perl.h (local) @@ -4768,9 +4768,9 @@ MEMBER_TO_FPTR(Perl_magic_setisa), 0, MEMBER_TO_FPTR(Perl_magic_setisa), + MEMBER_TO_FPTR(Perl_magic_freeisa), 0, 0, - 0, 0 ); === proto.h ================================================================== --- proto.h (revision 35104) +++ proto.h (local) @@ -1217,6 +1217,10 @@ __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); +PERL_CALLCONV int Perl_magic_freeisa(pTHX_ SV* sv, MAGIC* mg) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); === sv.c ================================================================== --- sv.c (revision 35104) +++ sv.c (local) @@ -4397,6 +4397,7 @@ */ if (!obj || obj == sv || how == PERL_MAGIC_arylen || + how == PERL_MAGIC_isaelem || how == PERL_MAGIC_qr || how == PERL_MAGIC_symtab || (SvTYPE(obj) == SVt_PVGV && === t/mro/basic.t ================================================================== --- t/mro/basic.t (revision 35104) +++ t/mro/basic.t (local) @@ -3,7 +3,7 @@ use strict; use warnings; -require q(./test.pl); plan(tests => 21); +require q(./test.pl); plan(tests => 27); { package MRO_A; @@ -127,6 +127,8 @@ } # clearing @ISA in different ways +# some are destructive to the package, hence the new +# package name each time { no warnings 'uninitialized'; { @@ -141,6 +143,48 @@ $ISACLEAR::ISA[1] = undef; ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX main ZZ/])); + # undef the array itself undef @ISACLEAR::ISA; ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR/])); } + +{ + { + package ISACLEAR2; + our @ISA = qw/XX YY ZZ/; + } + + # baseline + ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2 XX YY ZZ/])); + + # delete @ISA + delete $ISACLEAR2::{ISA}; + ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2/])); +} + +# another destructive test, undef the ISA glob +{ + { + package ISACLEAR3; + our @ISA = qw/XX YY ZZ/; + } + # baseline + ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3 XX YY ZZ/])); + + undef *ISACLEAR3::ISA; + ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3/])); +} + +# This is how Class::Inner does it +{ + { + package ISACLEAR4; + our @ISA = qw/XX YY ZZ/; + } + # baseline + ok(eq_array(mro::get_linear_isa('ISACLEAR4'),[qw/ISACLEAR4 XX YY ZZ/])); + + delete $ISACLEAR4::{ISA}; + delete $::{ISACLEAR4::}; + ok(eq_array(mro::get_linear_isa('ISACLEAR4'),[qw/ISACLEAR4/])); +} ```
p5pRT commented 17 years ago

From @nwc10

On Wed\, Jun 27\, 2007 at 10​:07​:54AM -0500\, Brandon Black wrote​:

obvious now. The source of the issue is that the special "setisa" magic is only applied to an @​ISA array at parse time\, not runtime.

Through a call down to gv_fetchpvn_flags() from somewhere in toke.c?

Even older Perls rely on this magic to increment PL_sub_generation. So in this example ...

@​Foo​::ISA = qw/A B/; undef *Foo​::ISA\, @​Foo​::ISA = qw/C D/;

... regardless of Perl version\, you've just permanently made method resolution buggy for that package\, because the "new" @​Foo​::ISA has no setisa magic\, and therefore depending on the surrounding code\, from this point forward the method cache entries for Foo could be from any version of its @​ISA\, not necessarily the latest one.

Arguably it's the same bug as this​:

$ perl -MDevel​::Peek -e 'Dump(\$!); undef *!; Dump(\$!);' Warning​: Use of "undef" without parentheses is ambiguous at -e line 1. SV = RV(0x807581c) at 0x804d16c   REFCNT = 1   FLAGS = (TEMP\,ROK)   RV = 0x804db68   SV = PVMG(0x8060a90) at 0x804db68   REFCNT = 2   FLAGS = (GMG\,SMG)   IV = 0   NV = 0   PV = 0   MAGIC = 0x8064638   MG_VIRTUAL = &PL_vtbl_sv   MG_TYPE = PERL_MAGIC_sv(\0)   MG_OBJ = 0x804dbbc   MG_LEN = 1   MG_PTR = 0x8050a80 "!" SV = RV(0x807581c) at 0x804d16c   REFCNT = 1   FLAGS = (TEMP\,ROK)   RV = 0x804db68   SV = NULL(0x0) at 0x804db68   REFCNT = 2   FLAGS = ()

We could probably paper over that issue by having a pp_aassign hook that checks for arrays named ISA in any package that don't have any magic\, and re-setting the magic there. I'm not sure if it's a good idea (perf-wise) to be putting a string comparison there though\, and also pp_assign doesn't currently really have any explicit knowledge about the real array it might be assigning to.

I'm not sure that it's a good idea either. It more feels like we should flag the typeglob in some way. But then that's counter to being able to 'undef' it.

It's somewhat an arms race. Introspection allows you to get at things\, but then that means that you can bugger them up. Maybe this is just part of Perl gives you the freedom.

Patient​: Doctor\, it hurts if I do this. Doctor​: Well\, don't do that then.

Nicholas Clark

p5pRT commented 17 years ago

From @rgs

On 27/06/07\, Nicholas Clark \nick@&#8203;ccl4\.org wrote​:

Arguably it's the same bug as this​:

$ perl -MDevel​::Peek -e 'Dump(\$!); undef *!; Dump(\$!);'

Not sure it's a genuine bug. I'd kind of expect undef *Foo to remove magic from Foo. And I use that when I localize *Foo...

p5pRT commented 17 years ago

From blblack@gmail.com

On 6/27/07\, Nicholas Clark \nick@&#8203;ccl4\.org wrote​:

On Wed\, Jun 27\, 2007 at 10​:07​:54AM -0500\, Brandon Black wrote​:

obvious now. The source of the issue is that the special "setisa" magic is only applied to an @​ISA array at parse time\, not runtime.

Through a call down to gv_fetchpvn_flags() from somewhere in toke.c?

Yup :)

Even older Perls rely on this magic to increment PL_sub_generation. So in this example ...

@​Foo​::ISA = qw/A B/; undef *Foo​::ISA\, @​Foo​::ISA = qw/C D/;

... regardless of Perl version\, you've just permanently made method resolution buggy for that package\, because the "new" @​Foo​::ISA has no setisa magic\, and therefore depending on the surrounding code\, from this point forward the method cache entries for Foo could be from any version of its @​ISA\, not necessarily the latest one.

Arguably it's the same bug as this​:

$ perl -MDevel​::Peek -e 'Dump(\$!); undef *!; Dump(\$!);' Warning​: Use of "undef" without parentheses is ambiguous at -e line 1. SV = RV(0x807581c) at 0x804d16c REFCNT = 1 FLAGS = (TEMP\,ROK) RV = 0x804db68 SV = PVMG(0x8060a90) at 0x804db68 REFCNT = 2 FLAGS = (GMG\,SMG) IV = 0 NV = 0 PV = 0 MAGIC = 0x8064638 MG_VIRTUAL = &PL_vtbl_sv MG_TYPE = PERL_MAGIC_sv(\0) MG_OBJ = 0x804dbbc MG_LEN = 1 MG_PTR = 0x8050a80 "!" SV = RV(0x807581c) at 0x804d16c REFCNT = 1 FLAGS = (TEMP\,ROK) RV = 0x804db68 SV = NULL(0x0) at 0x804db68 REFCNT = 2 FLAGS = ()

Yes\, the same basic issue applies to all special magical variables. @​ISA is just a more insidious case because it's not a global\, it potentially exists in every package.

We could probably paper over that issue by having a pp_aassign hook that checks for arrays named ISA in any package that don't have any magic\, and re-setting the magic there. I'm not sure if it's a good idea (perf-wise) to be putting a string comparison there though\, and also pp_assign doesn't currently really have any explicit knowledge about the real array it might be assigning to.

I'm not sure that it's a good idea either. It more feels like we should flag the typeglob in some way. But then that's counter to being able to 'undef' it.

It's somewhat an arms race. Introspection allows you to get at things\, but then that means that you can bugger them up. Maybe this is just part of Perl gives you the freedom.

With 10-15 years of hindsight\, I'd say that at least some forms of magic should be defined by the name of the variable and always apply to any access of it\, rather than set within the variable and being subject to being undef-ed away. However I suspect such a radical change would touch a lot of things all over the codebase\, and be too invasive to do now.

p5pRT commented 17 years ago

From @rgs

On 27/06/07\, Brandon Black \blblack@&#8203;gmail\.com wrote​:

We could probably paper over that issue by having a pp_aassign hook that checks for arrays named ISA in any package that don't have any magic\, and re-setting the magic there. I'm not sure if it's a good idea (perf-wise) to be putting a string comparison there though\, and also pp_assign doesn't currently really have any explicit knowledge about the real array it might be assigning to.

I'd rather avoid this. And document the issue\, maybe.

The attached patch fixes the Class​::Inner case (and other related ones) in the sense that the mro code really believes that @​ISA is empty when you destroy it any manner of oddball way\, like undef *Foo​::ISA\, delete $Foo​::{ISA}\, etc\, but it doesn't address the fact that the package is kinda screwed from that point forward as detailed above.

Thanks\, applied as #31489.

p5pRT commented 15 years ago

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