Rewrite txn_do and dbh_do to use a (hidden for now) blockrunner
[dbsrgits/DBIx-Class.git] / t / 52leaks.t
index 5614252..d76fa38 100644 (file)
@@ -140,11 +140,16 @@ my @compose_ns_classes;
   # txn_do to invoke more codepaths
   my ($mc_row_obj, $pager, $pager_explicit_count) = $schema->txn_do (sub {
 
-    my $artist = $rs->create ({
+    my $artist = $schema->resultset('Artist')->create ({
       name => 'foo artist',
       cds => [{
         title => 'foo cd',
         year => 1984,
+        tracks => [
+          { title => 't1' },
+          { title => 't2' },
+        ],
+        genre => { name => 'mauve' },
       }],
     });
 
@@ -155,6 +160,32 @@ my @compose_ns_classes;
     return ($artist, $pg, $pg_wcount);
   });
 
+  # more codepaths - error handling in txn_do
+  {
+    eval { $schema->txn_do ( sub {
+      $storage->_dbh->begin_work;
+      fail ('how did we get so far?!');
+    } ) };
+
+    eval { $schema->txn_do ( sub {
+      $schema->txn_do ( sub {
+        die "It's called EXCEPTION";
+        fail ('how did we get so far?!');
+      } );
+      fail ('how did we get so far?!');
+    } ) };
+    like( $@, qr/It\'s called EXCEPTION/, 'Exception correctly propagated in nested txn_do' );
+  }
+
+  # dbh_do codepath
+  my ($rs_bind_circref, $cond_rowobj) = $schema->storage->dbh_do ( sub {
+    my $row = $_[0]->schema->resultset('Artist')->new({});
+    my $rs = $_[0]->schema->resultset('Artist')->search({
+      name => $row,  # this is deliberately bogus, see FIXME below!
+    });
+    return ($rs, $row);
+  });
+
   is ($pager->next_page, 3, 'There is one more page available');
 
   # based on 66 per 10 pages
@@ -179,21 +210,60 @@ my @compose_ns_classes;
     $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' ] } ),
 
     row_object => $row_obj,
 
+    mc_row_object => $mc_row_obj,
+
     result_source => $rs->result_source,
 
     result_source_handle => $rs->result_source->handle,
 
     pager_explicit_count => $pager_explicit_count,
 
+    leaky_resultset => $rs_bind_circref,
+    leaky_resultset_cond => $cond_rowobj,
+    leaky_resultset_member => $rs_bind_circref->next,
   };
 
   require Storable;
@@ -201,6 +271,7 @@ my @compose_ns_classes;
     %$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,
@@ -229,8 +300,13 @@ my @compose_ns_classes;
     $base_collection->{"DBI handle $_"} = $_;
   }
 
-  if ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_leaks') ) {
-    Test::Memory::Cycle::memory_cycle_ok ($base_collection, 'No cycles in the object collection')
+  SKIP: {
+    if ( DBIx::Class::Optional::Dependencies->req_ok_for ('test_leaks') ) {
+      Test::Memory::Cycle::memory_cycle_ok ($base_collection, 'No cycles in the object collection')
+    }
+    else {
+      skip 'Circular ref test needs ' .  DBIx::Class::Optional::Dependencies->req_missing_for ('test_leaks'), 1;
+    }
   }
 
   for (keys %$base_collection) {
@@ -254,8 +330,12 @@ my @compose_ns_classes;
     sub { shift->result_source },
     sub { shift->schema },
     sub { shift->clone },
-    sub { shift->resultset('Artist') },
+    sub { shift->resultset('CD') },
+    sub { shift->next },
+    sub { shift->artist },
+    sub { shift->search_related('cds') },
     sub { shift->next },
+    sub { shift->search_related('artist') },
     sub { shift->result_source },
     sub { shift->resultset },
     sub { shift->create({ name => 'detached' }) },
@@ -287,6 +367,10 @@ for my $slot (keys %$weak_registry) {
     # T::B 2.0 has result objects and other fancyness
     delete $weak_registry->{$slot};
   }
+  elsif ($slot =~ /^Method::Generate::(?:Accessor|Constructor)/) {
+    # Moo keeps globals around, this is normal
+    delete $weak_registry->{$slot};
+  }
   elsif ($slot =~ /^SQL::Translator/) {
     # SQLT is a piece of shit, leaks all over
     delete $weak_registry->{$slot};
@@ -333,6 +417,22 @@ for my $moniker ( keys %{DBICTest::Schema->source_registrations || {}} ) {
   delete $weak_registry->{DBICTest::Schema->source($moniker)};
 }
 
+# FIXME !!!
+# There is an actual strong circular reference taking place here, but because
+# half of it is in XS no leaktracer sees it, and Devel::FindRef is equally
+# stumped when trying to trace the origin. The problem is:
+#
+# $cond_object --> result_source --> schema --> storage --> $dbh --> {cached_kids}
+#          ^                                                           /
+#           \-------- bound value on prepared/cached STH  <-----------/
+#
+TODO: {
+  local $TODO = 'Not sure how to fix this yet, an entanglment could be an option';
+  my $r = $weak_registry->{'basic leaky_resultset_cond'}{weakref};
+  ok(! defined $r, 'We no longer leak!')
+    or $r->result_source(undef);
+}
+
 for my $slot (sort keys %$weak_registry) {
 
   ok (! defined $weak_registry->{$slot}{weakref}, "No leaks of $slot") or do {