[Bast-commits] r9807 - in Class-Accessor-Grouped/trunk: . lib/Class/Accessor

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-12-08 09:49:27 +0000 (Wed, 08 Dec 2010)
New Revision: 9807

Modified:
   Class-Accessor-Grouped/trunk/Changes
   Class-Accessor-Grouped/trunk/lib/Class/Accessor/Grouped.pm
Log:
Fix undefer tracker to play nice with Module::Unload (DBICSL)

Modified: Class-Accessor-Grouped/trunk/Changes
===================================================================
--- Class-Accessor-Grouped/trunk/Changes	2010-11-27 17:54:08 UTC (rev 9806)
+++ Class-Accessor-Grouped/trunk/Changes	2010-12-08 09:49:27 UTC (rev 9807)
@@ -1,5 +1,6 @@
 Revision history for Class::Accessor::Grouped.
 
+    - Fix spurious method re-invocation warnings after Class::Unload
 
 0.10000 Sat Nov 27 17:51:04 2010
     - Fix perl 5.6 failures

Modified: Class-Accessor-Grouped/trunk/lib/Class/Accessor/Grouped.pm
===================================================================
--- Class-Accessor-Grouped/trunk/lib/Class/Accessor/Grouped.pm	2010-11-27 17:54:08 UTC (rev 9806)
+++ Class-Accessor-Grouped/trunk/lib/Class/Accessor/Grouped.pm	2010-12-08 09:49:27 UTC (rev 9807)
@@ -646,24 +646,25 @@
     die sprintf( "Class::XSAccessor requested but not available:\n%s\n", __CAG_NO_CXSA )
       if __CAG_NO_CXSA;
 
-    my %deferred_calls_seen;
-
     return sub {
       my $current_class = Scalar::Util::blessed( $_[0] ) || $_[0];
 
       if (__CAG_TRACK_UNDEFER_FAIL) {
+        my $deferred_calls_seen = do {
+          no strict 'refs';
+          \%{"${current_class}::__cag_deferred_xs_shim_invocations"}
+        };
         my @cframe = caller(0);
-        if ($deferred_calls_seen{$current_class}{$cframe[3]}) {
+        if (my $already_seen = $deferred_calls_seen->{$cframe[3]}) {
           Carp::carp (
             "Deferred version of method $cframe[3] invoked more than once (originally "
-          . "invoked at $deferred_calls_seen{$current_class}{$cframe[3]}). This is a strong "
-          . 'indication your code has cached the original ->can derived method coderef, '
-          . 'and is using it instead of the proper method re-lookup, causing performance '
-          . 'regressions'
+          . "invoked at $already_seen). This is a strong indication your code has "
+          . 'cached the original ->can derived method coderef, and is using it instead '
+          . 'of the proper method re-lookup, causing performance regressions'
           );
         }
         else {
-          $deferred_calls_seen{$current_class}{$cframe[3]} = "$cframe[1] line $cframe[2]";
+          $deferred_calls_seen->{$cframe[3]} = "$cframe[1] line $cframe[2]";
         }
       }