From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 9 Sep 2013 23:32:38 +0000 (+0000)
Subject: Test for deletion actually ... deleting ... things.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=498cec1bec4c9cfd15d090aac95c356a90f3f07b;p=scpubgit%2Fstemmatology.git

Test for deletion actually ... deleting ... things.

Since we're using the DBI backend, everything's stored in the 'entries'
table in the SQLite database - which has, among other things, a 'class'
column storing the perl class of the entry. So I can run -

  SELECT class, COUNT(*) FROM entries GROUP BY class

to get the current counts in the database. I've altered the test to
collect these after the first tradition creation, after the second, and
after the deletion of the first - then added a loop to the end to check
that the final count is the second count minus the first for each class.

This seems to accurately reflect what we expect the database to look like
after a (successful) garbage collection run.
---

diff --git a/t/text_tradition_directory.t b/t/text_tradition_directory.t
index 8950148..3b5d693 100644
--- a/t/text_tradition_directory.t
+++ b/t/text_tradition_directory.t
@@ -7,7 +7,6 @@ $| = 1;
 
 
 # =begin testing
-{
 use TryCatch;
 use File::Temp;
 use Text::Tradition;
@@ -15,6 +14,7 @@ use_ok 'Text::Tradition::Directory';
 
 my $fh = File::Temp->new();
 my $file = $fh->filename;
+if ($ARGV[0] eq 'test.db') { unlink($file = 'test.db') }
 $fh->close;
 my $dsn = "dbi:SQLite:dbname=$file";
 my $uuid;
@@ -23,6 +23,13 @@ my $t = Text::Tradition->new(
 	'input' => 'Tabular',
 	'file'  => 't/data/simple.txt',
 	);
+my $obj_dbh = DBI->connect($dsn);
+
+sub get_counts {
+  map @$_, @{$obj_dbh->selectall_arrayref(
+    'SELECT class, COUNT(*) FROM entries GROUP BY class'
+  )};
+}
 
 {
 	my $d = Text::Tradition::Directory->new( 'dsn' => $dsn,
@@ -45,6 +52,9 @@ my $t = Text::Tradition->new(
 			"Exception has correct message" );
 	}
 }
+
+my %first_counts = get_counts();
+
 my $nt = Text::Tradition->new(
 	'name' => 'CX',
 	'input' => 'CollateX',
@@ -52,6 +62,8 @@ my $nt = Text::Tradition->new(
 	);
 is( ref( $nt ), 'Text::Tradition', "Made new tradition" );
 
+my %second_counts;
+
 {
 	my $f = Text::Tradition::Directory->new( 'dsn' => $dsn );
 	my $scope = $f->new_scope;
@@ -78,6 +90,8 @@ is( ref( $nt ), 'Text::Tradition', "Made new tradition" );
 		like( $e->message, qr/Cannot directly delete non-Tradition object/, 
 			"Exception has correct message" );
 	}
+
+        %second_counts = get_counts;
 	
 	$f->delete( $uuid );
 	ok( !$f->exists( $uuid ), "Object is deleted from DB" );
@@ -94,9 +108,17 @@ is( ref( $nt ), 'Text::Tradition', "Made new tradition" );
 	my @w2 = sort{ $a->sigil cmp $b->sigil } $nt->witnesses;
 	is_deeply( \@w1, \@w2, "Looked up remaining tradition by name" );
 }
-}
-
 
+my %final_counts = get_counts();
 
+foreach my $class (sort keys %final_counts) {
+  my ($first, $second, $final) = map $_->{$class}, (
+    \%first_counts, \%second_counts, \%final_counts
+  );
+  cmp_ok(
+    $final, '==', ($second - $first),
+    "Final count for ${class} is $final ($second - $first)"
+  );
+}
 
 1;