X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=4f75810005188586a381d5d79f29b616376fc0d8;hb=052b8ce2ec154827133b0b08042487c5617300aa;hp=792c3d331ef06eceb93bfe5ebc7bc689b6f5b6a8;hpb=d5e5fb4b47b759b202e552ff1d2f1dd393ac7b39;p=dbsrgits%2FDBIx-Class.git diff --git a/t/52leaks.t b/t/52leaks.t index 792c3d3..4f75810 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -97,9 +97,10 @@ unless (DBICTest::RunMode->is_plain) { ok ($storage->connected, 'we are connected'); - my $row_obj = $rs->next; + my $row_obj = $rs->search({}, { rows => 1})->next; # so that commits/rollbacks work ok ($row_obj, 'row from db'); + # txn_do to invoke more codepaths my ($mc_row_obj, $pager, $pager_explicit_count) = $schema->txn_do (sub { my $artist = $rs->create ({ @@ -122,12 +123,35 @@ unless (DBICTest::RunMode->is_plain) { # based on 66 per 10 pages is ($pager_explicit_count->last_page, 7, 'Correct last page'); + # do some population (invokes some extra codepaths) + # also exercise the guard code and the manual txn control + { + my $guard = $schema->txn_scope_guard; + # populate with bindvars + $rs->populate([{ name => 'James Bound' }]); + $guard->commit; + + $schema->txn_begin; + # populate mixed + $rs->populate([{ name => 'James Rebound', rank => \ '11' }]); + $schema->txn_commit; + + $schema->txn_begin; + # and without bindvars + $rs->populate([{ name => \ '"James Unbound"' }]); + $schema->txn_rollback; + } + my $base_collection = { schema => $schema, storage => $storage, resultset => $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, result_source => $rs->result_source, @@ -165,7 +189,7 @@ for my $slot (keys %$weak_registry) { delete $weak_registry->{$slot}; } elsif ($slot =~ /^\QHash::Merge/) { - # only clear one object - more would indicate trouble + # only clear one object of a specific behavior - more would indicate trouble delete $weak_registry->{$slot} unless $cleared->{hash_merge_singleton}{$weak_registry->{$slot}{weakref}{behavior}}++; }