X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F52leaks.t;h=6707b830fa94e2801313f27af17c27c5759601fa;hb=e0b2dc7456481be6870a23a5927a99c8416c82f7;hp=6d3c53fdf4885f763c5bae84ce7ea51de55e319e;hpb=66917da3d4982b89c8ba4ed97fa9fb8bc4539171;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/t/52leaks.t b/t/52leaks.t
index 6d3c53f..6707b83 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -35,9 +35,10 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
 
 use lib qw(t/lib);
 use DBICTest::RunMode;
+use DBIx::Class;
 BEGIN {
   plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
-    if DBICTest::RunMode->peepeeness;
+    if DBIx::Class::_ENV_::PEEPEENESS();
 }
 
 use Scalar::Util qw/refaddr reftype weaken/;
@@ -54,6 +55,9 @@ BEGIN {
 # this is what holds all weakened refs to be checked for leakage
 my $weak_registry = {};
 
+# whether or to invoke IC::DT
+my $has_dt;
+
 # Skip the heavy-duty leak tracing when just doing an install
 unless (DBICTest::RunMode->is_plain) {
   # Some modules are known to install singletons on-load
@@ -66,6 +70,9 @@ unless (DBICTest::RunMode->is_plain) {
   require Hash::Merge;
   require Storable;
 
+  # this loads the DT armada as well
+  $has_dt = DBIx::Class::Optional::Dependencies->req_ok_for('test_dt_sqlite');
+
   no warnings qw/redefine once/;
   no strict qw/refs/;
 
@@ -191,6 +198,21 @@ unless (DBICTest::RunMode->is_plain) {
     dbh => $storage->_dbh,
   );
 
+  if ($has_dt) {
+    my $rs = $base_collection->{icdt_rs} = $schema->resultset('Event');
+
+    my $now = DateTime->now;
+    for (1..5) {
+      $base_collection->{"icdt_row_$_"} = $rs->create({
+        created_on => DateTime->new(year => 2011, month => 1, day => $_, time_zone => "-0${_}00" ),
+        starts_at => $now->clone->add(days => $_),
+      });
+    }
+
+    # re-search
+    my @dummy = $rs->all;
+  }
+
   memory_cycle_ok ($base_collection, 'No cycles in the object collection')
     if $have_test_cycle;
 
@@ -243,15 +265,15 @@ unless (DBICTest::RunMode->is_plain) {
 # Naturally we have some exceptions
 my $cleared;
 for my $slot (keys %$weak_registry) {
-  if ($slot =~ /^\QTest::Builder/) {
+  if ($slot =~ /^Test::Builder/) {
     # T::B 2.0 has result objects and other fancyness
     delete $weak_registry->{$slot};
   }
-  elsif ($slot =~ /^\QSQL::Translator/) {
+  elsif ($slot =~ /^SQL::Translator/) {
     # SQLT is a piece of shit, leaks all over
     delete $weak_registry->{$slot};
   }
-  elsif ($slot =~ /^\QHash::Merge/) {
+  elsif ($slot =~ /^Hash::Merge/) {
     # 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}}++;