diff options
| -rw-r--r-- | sv.c | 15 | ||||
| -rwxr-xr-x | t/op/misc.t | 44 |
2 files changed, 57 insertions, 2 deletions
@@ -335,8 +335,19 @@ do_clean_objs(SV *sv) static void do_clean_named_objs(SV *sv) { - if (SvTYPE(sv) == SVt_PVGV && GvSV(sv)) - do_clean_objs(GvSV(sv)); + if (SvTYPE(sv) == SVt_PVGV) { + if ( SvOBJECT(GvSV(sv)) || + GvAV(sv) && SvOBJECT(GvAV(sv)) || + GvHV(sv) && SvOBJECT(GvHV(sv)) || + GvIO(sv) && SvOBJECT(GvIO(sv)) || + GvCV(sv) && SvOBJECT(GvCV(sv)) ) + { + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));) + SvREFCNT_dec(sv); + } + else if (GvSV(sv)) + do_clean_objs(GvSV(sv)); + } } #endif diff --git a/t/op/misc.t b/t/op/misc.t index 40c9c38825..582ffa7905 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -368,3 +368,47 @@ EXPECT 1 2 ######## +package X; +sub ascalar { my $r; bless \$r } +sub DESTROY { print "destroyed\n" }; +package main; +*s = ascalar X; +EXPECT +destroyed +######## +package X; +sub anarray { bless [] } +sub DESTROY { print "destroyed\n" }; +package main; +*a = anarray X; +EXPECT +destroyed +######## +package X; +sub ahash { bless {} } +sub DESTROY { print "destroyed\n" }; +package main; +*h = ahash X; +EXPECT +destroyed +######## +package X; +sub aclosure { my $x; bless sub { ++$x } } +sub DESTROY { print "destroyed\n" }; +package main; +*c = aclosure X; +EXPECT +destroyed +######## +package X; +sub any { bless {} } +my $f = "FH000"; # just to thwart any future optimisations +sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r } +sub DESTROY { print "destroyed\n" } +package main; +$x = any X; # to bump sv_objcount. IO objs aren't counted?? +*f = afh X; +EXPECT +destroyed +destroyed +######## |