[REPATCH] Attribute::Handlers lexical refcount circus

Message-ID: <20020116173431.GA28924@mirth.demon.co.uk>

p4raw-id: //depot/perl@14306

2 files changed, 39 insertions, 1 deletions

diff --git a/lib/Attribute/Handlers.pm b/lib/Attribute/Handlers.pm
index f12d1d9855..d4cbfffc25 100644
--- a/lib/Attribute/Handlers.pm
+++ b/lib/Attribute/Handlers.pm
@@ -145,7 +145,11 @@ sub _gen_handler_AH_() {
 			    _apply_handler_AH_($decl,$gphase)
 				if $global_phases{$gphase} <= $global_phase;
 			}
-			push @declarations, $decl;
+			# if _gen_handler_AH_ is being called after CHECK it's
+			# for a lexical, so we don't want to keep a reference 
+			# around
+			push @declarations, $decl
+				if $global_phase == 0;
 		}
 		$_ = undef;
 	    }
diff --git a/lib/Attribute/Handlers/t/multi.t b/lib/Attribute/Handlers/t/multi.t
index cc57889183..c327b390d5 100644
--- a/lib/Attribute/Handlers/t/multi.t
+++ b/lib/Attribute/Handlers/t/multi.t
@@ -131,3 +131,37 @@ $noisy[0]++;
 my %rowdy : Rowdy(37,'this arg should be ignored');
 $rowdy{key}++;
 
+
+# check that applying attributes to lexicals doesn't unduly worry
+# their refcounts
+my $out = "begin\n";
+my $applied;
+sub UNIVERSAL::Dummy :ATTR { ++$applied };
+sub Dummy::DESTROY { $out .= "bye\n" }
+
+{ my $dummy;          $dummy = bless {}, 'Dummy'; }
+ok( $out eq "begin\nbye\n", 45 );
+
+{ my $dummy : Dummy;  $dummy = bless {}, 'Dummy'; }
+ok( $out eq "begin\nbye\nbye\n", 46 );
+
+# are lexical attributes reapplied correctly?
+sub dummy { my $dummy : Dummy; }
+$applied = 0;
+dummy(); dummy();
+ok( $applied == 2, 47 );
+
+# 45-47 again, but for our variables
+$out = "begin\n";
+{ our $dummy;          $dummy = bless {}, 'Dummy'; }
+ok( $out eq "begin\n", 48 );
+{ our $dummy : Dummy;  $dummy = bless {}, 'Dummy'; }
+ok( $out eq "begin\nbye\n", 49 );
+undef $::dummy;
+ok( $out eq "begin\nbye\nbye\n", 50 );
+
+# are lexical attributes reapplied correctly?
+sub dummy_our { our $banjo : Dummy; }
+$applied = 0;
+dummy_our(); dummy_our();
+ok( $applied == 0, 51 );