X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=ea055a607b66c4cd570f2bcfbe65dd5c294aa221;hb=0a03206ab54cce5df165c4703bcf8a43252e46ba;hp=ce6d14c3dcae93dbaa34348ef48f0d3007548278;hpb=eb7aa96091132ffd9f6256d2ff3d341102b60003;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/52leaks.t b/t/52leaks.t
index ce6d14c..ea055a6 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -36,9 +36,10 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
 use lib qw(t/lib);
 use DBICTest::RunMode;
 use DBIx::Class;
+use B 'svref_2object';
 BEGIN {
   plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
-    if DBIx::Class::_ENV_::PEEPEENESS();
+    if DBIx::Class::_ENV_::PEEPEENESS;
 }
 
 use Scalar::Util qw/refaddr reftype weaken/;
@@ -121,6 +122,7 @@ unless (DBICTest::RunMode->is_plain) {
   %$weak_registry = ();
 }
 
+my @compose_ns_classes;
 {
   use_ok ('DBICTest');
 
@@ -128,6 +130,8 @@ unless (DBICTest::RunMode->is_plain) {
   my $rs = $schema->resultset ('Artist');
   my $storage = $schema->storage;
 
+  @compose_ns_classes = map { "DBICTest::${_}" } keys %{$schema->source_registrations};
+
   ok ($storage->connected, 'we are connected');
 
   my $row_obj = $rs->search({}, { rows => 1})->next;  # so that commits/rollbacks work
@@ -175,9 +179,43 @@ unless (DBICTest::RunMode->is_plain) {
     $schema->txn_rollback;
   }
 
+  # prefetching
+  my $cds_rs = $schema->resultset('CD');
+  my $cds_with_artist = $cds_rs->search({}, { prefetch => 'artist' });
+  my $cds_with_tracks = $cds_rs->search({}, { prefetch => 'tracks' });
+  my $cds_with_stuff = $cds_rs->search({}, { prefetch => [ 'genre', { artist => { cds => { tracks => 'cd_single' } } } ] });
+
+  # implicit pref
+  my $cds_with_impl_artist = $cds_rs->search({}, { columns => [qw/me.title artist.name/], join => 'artist' });
+
+  # get_column
+  my $getcol_rs = $cds_rs->get_column('me.cdid');
+  my $pref_getcol_rs = $cds_with_stuff->get_column('me.cdid');
+
+  # fire the column getters
+  my @throwaway = $pref_getcol_rs->all;
+
   my $base_collection = {
     resultset => $rs,
 
+    pref_precursor => $cds_rs,
+
+    pref_rs_single => $cds_with_artist,
+    pref_rs_multi => $cds_with_tracks,
+    pref_rs_nested => $cds_with_stuff,
+
+    pref_rs_implicit => $cds_with_impl_artist,
+
+    pref_row_single => $cds_with_artist->next,
+    pref_row_multi => $cds_with_tracks->next,
+    pref_row_nested => $cds_with_stuff->next,
+
+    # even though this does not leak Storable croaks on it :(((
+    #pref_row_implicit => $cds_with_impl_artist->next,
+
+    get_column_rs_plain => $getcol_rs,
+    get_column_rs_pref => $pref_getcol_rs,
+
     # twice so that we make sure only one H::M object spawned
     chained_resultset => $rs->search_rs ({}, { '+columns' => [ 'foo' ] } ),
     chained_resultset2 => $rs->search_rs ({}, { '+columns' => [ 'bar' ] } ),
@@ -188,10 +226,7 @@ unless (DBICTest::RunMode->is_plain) {
 
     result_source_handle => $rs->result_source->handle,
 
-    fresh_pager => $rs->page(5)->pager,
-    pager => $pager,
     pager_explicit_count => $pager_explicit_count,
-
   };
 
   require Storable;
@@ -199,10 +234,13 @@ unless (DBICTest::RunMode->is_plain) {
     %$base_collection,
     refrozen => Storable::dclone( $base_collection ),
     rerefrozen => Storable::dclone( Storable::dclone( $base_collection ) ),
+    pref_row_implicit => $cds_with_impl_artist->next,
     schema => $schema,
     storage => $storage,
     sql_maker => $storage->sql_maker,
     dbh => $storage->_dbh,
+    fresh_pager => $rs->page(5)->pager,
+    pager => $pager,
   );
 
   if ($has_dt) {
@@ -267,6 +305,7 @@ unless (DBICTest::RunMode->is_plain) {
       reftype $phantom,
       refaddr $phantom,
     );
+
     $weak_registry->{$slot} = $phantom;
     weaken $weak_registry->{$slot};
   }
@@ -291,9 +330,8 @@ for my $slot (keys %$weak_registry) {
     delete $weak_registry->{$slot}
       unless $cleared->{hash_merge_singleton}{$weak_registry->{$slot}{weakref}{behavior}}++;
   }
-  elsif ($slot =~ /^__TxnScopeGuard__FIXUP__/) {
+  elsif (DBIx::Class::_ENV_::INVISIBLE_DOLLAR_AT and $slot =~ /^__TxnScopeGuard__FIXUP__/) {
     delete $weak_registry->{$slot}
-      if $] > 5.013001 and $] < 5.013008;
   }
   elsif ($slot =~ /^DateTime::TimeZone/) {
     # DT is going through a refactor it seems - let it leak zones for now
@@ -301,25 +339,32 @@ for my $slot (keys %$weak_registry) {
   }
 }
 
-
-# FIXME
-# For reasons I can not yet fully understand the table() god-method (located in
-# ::ResultSourceProxy::Table) attaches an actual source instance to each class
-# as virtually *immortal* class-data. 
-# For now just ignore these instances manually but there got to be a saner way
-for ( map { $_->result_source_instance } (
+# every result class has a result source instance as classdata
+# make sure these are all present and distinct before ignoring
+# (distinct means only 1 reference)
+for my $rs_class (
   'DBICTest::BaseResult',
+  @compose_ns_classes,
   map { DBICTest::Schema->class ($_) } DBICTest::Schema->sources
-)) {
-  delete $weak_registry->{$_};
+) {
+  # need to store the SVref and examine it separately, to push the rsrc instance off the pad
+  my $SV = svref_2object($rs_class->result_source_instance);
+  is( $SV->REFCNT, 1, "Source instance of $rs_class referenced exactly once" );
+
+  # ignore it
+  delete $weak_registry->{$rs_class->result_source_instance};
 }
 
-# FIXME
-# same problem goes for the schema - its classdata contains live result source
-# objects, which to add insult to the injury are *different* instances from the
-# ones we ignored above
-for ( values %{DBICTest::Schema->source_registrations || {}} ) {
-  delete $weak_registry->{$_};
+# Schema classes also hold sources, but these are clones, since
+# each source contains the schema (or schema class name in this case)
+# Hence the clone so that the same source can be registered with
+# multiple schemas
+for my $moniker ( keys %{DBICTest::Schema->source_registrations || {}} ) {
+
+  my $SV = svref_2object(DBICTest::Schema->source($moniker));
+  is( $SV->REFCNT, 1, "Source instance registered under DBICTest::Schema as $moniker referenced exactly once" );
+
+  delete $weak_registry->{DBICTest::Schema->source($moniker)};
 }
 
 for my $slot (sort keys %$weak_registry) {
@@ -338,7 +383,6 @@ for my $slot (sort keys %$weak_registry) {
   };
 }
 
-
 # we got so far without a failure - this is a good thing
 # now let's try to rerun this script under a "persistent" environment
 # this is ugly and dirty but we do not yet have a Test::Embedded or