From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 29 May 2016 14:00:22 +0000 (+0200)
Subject: Proper attribute support under ithreads (fix 7bd921c0)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0130575a1a5ad9249a5cdc705c043286fabdf32c;p=dbsrgits%2FDBIx-Class-Historic.git

Proper attribute support under ithreads (fix 7bd921c0)

The previous implementation was rushed (for decidedly non-technical reasons)
and is predictably completely wrong :/

Properly fix renumbering of the registry, and add a double-thread test to
catch future problems

Read under --color-words
---

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index ef1c60e..61c09b1 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -45,7 +45,7 @@ BEGIN {
 sub component_base_class { 'DBIx::Class' }
 
 
-my $cref_registry;
+my $attr_cref_registry;
 sub DBIx::Class::__Attr_iThreads_handler__::CLONE {
 
   # this is disgusting, but the best we can do without even more surgery
@@ -64,12 +64,22 @@ sub DBIx::Class::__Attr_iThreads_handler__::CLONE {
         and
       ref( my $attr_stash = ${"${pkg}::__cag___attr_cache"} ) eq 'HASH'
     ) {
-      $attr_stash->{ $cref_registry->{$_} } = delete $attr_stash->{$_}
+      $attr_stash->{ $attr_cref_registry->{$_}{weakref} } = delete $attr_stash->{$_}
         for keys %$attr_stash;
     }
 
     return 1;
-  })
+  });
+
+  # renumber the cref registry itself
+  %$attr_cref_registry = map {
+    ( defined $_->{weakref} )
+      ? (
+        # because of how __attr_cache works, ugh
+        "$_->{weakref}"         => $_,
+      )
+      : ()
+  } values %$attr_cref_registry;
 }
 
 sub MODIFY_CODE_ATTRIBUTES {
@@ -78,20 +88,20 @@ sub MODIFY_CODE_ATTRIBUTES {
     unless $class->can('__attr_cache');
 
   # compaction step
-  defined $cref_registry->{$_} or delete $cref_registry->{$_}
-    for keys %$cref_registry;
+  defined $attr_cref_registry->{$_}{weakref} or delete $attr_cref_registry->{$_}
+    for keys %$attr_cref_registry;
 
   # The original API used stringification instead of refaddr - can't change that now
-  if( $cref_registry->{$code} ) {
+  if( $attr_cref_registry->{$code} ) {
     Carp::confess( sprintf
       "Coderefs '%s' and '%s' stringify to the same value '%s': nothing will work",
       refdesc($code),
-      refdesc($cref_registry->{$code}),
+      refdesc($attr_cref_registry->{$code}{weakref}),
       "$code"
-    ) if refaddr($cref_registry->{$code}) != refaddr($code);
+    ) if refaddr($attr_cref_registry->{$code}{weakref}) != refaddr($code);
   }
   else {
-    weaken( $cref_registry->{$code} = $code )
+    weaken( $attr_cref_registry->{$code}{weakref} = $code )
   }
 
   $class->__attr_cache->{$code} = [ sort( uniq(
diff --git a/xt/extra/internals/attributes.t b/xt/extra/internals/attributes.t
index 5c9b50d..e305f97 100644
--- a/xt/extra/internals/attributes.t
+++ b/xt/extra/internals/attributes.t
@@ -23,7 +23,6 @@ BEGIN {
 use Test::More;
 use DBIx::Class::_Util qw( quote_sub modver_gt_or_eq );
 
-### Test the upcoming attributes support
 require DBIx::Class;
 @DBICTest::ATTRTEST::ISA  = 'DBIx::Class';
 
@@ -102,10 +101,17 @@ if ($skip_threads) {
 }
 else {
   threads->create(sub {
-    add_more_attrs();
+
+    threads->create(sub {
+
+      add_more_attrs();
+      select( undef, undef, undef, 0.2 ); # without this many tasty crashes even on latest perls
+
+    })->join;
+
     select( undef, undef, undef, 0.2 ); # without this many tasty crashes even on latest perls
+
   })->join;
 }
 
-
 done_testing;