Change 14306 by jhi@alpha on 2002/01/17 13:57:53
Subject: [REPATCH] Attribute::Handlers lexical refcount circus
From: Richard Clamp <[EMAIL PROTECTED]>
Date: Wed, 16 Jan 2002 17:34:31 +0000
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/lib/Attribute/Handlers.pm#12 edit
.... //depot/perl/lib/Attribute/Handlers/t/multi.t#5 edit
Differences ...
==== //depot/perl/lib/Attribute/Handlers.pm#12 (text) ====
Index: perl/lib/Attribute/Handlers.pm
--- perl/lib/Attribute/Handlers.pm.~1~ Thu Jan 17 07:15:05 2002
+++ perl/lib/Attribute/Handlers.pm Thu Jan 17 07:15:05 2002
@@ -145,7 +145,11 @@
_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;
}
==== //depot/perl/lib/Attribute/Handlers/t/multi.t#5 (text) ====
Index: perl/lib/Attribute/Handlers/t/multi.t
--- perl/lib/Attribute/Handlers/t/multi.t.~1~ Thu Jan 17 07:15:05 2002
+++ perl/lib/Attribute/Handlers/t/multi.t Thu Jan 17 07:15:05 2002
@@ -131,3 +131,37 @@
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 );
End of Patch.
