[Bast-commits] r6268 - DBIx-Class/0.08/branches/joined_count/t/delete

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Fri May 15 08:43:04 GMT 2009


Author: ribasushi
Date: 2009-05-15 08:43:04 +0000 (Fri, 15 May 2009)
New Revision: 6268

Modified:
   DBIx-Class/0.08/branches/joined_count/t/delete/related.t
Log:
Add failing multikey rs delete (and by implication update) test

Modified: DBIx-Class/0.08/branches/joined_count/t/delete/related.t
===================================================================
--- DBIx-Class/0.08/branches/joined_count/t/delete/related.t	2009-05-15 02:04:12 UTC (rev 6267)
+++ DBIx-Class/0.08/branches/joined_count/t/delete/related.t	2009-05-15 08:43:04 UTC (rev 6268)
@@ -4,7 +4,7 @@
 use lib qw(t/lib);
 use DBICTest;
 
-plan tests => 3;
+plan tests => 6;
 
 my $schema = DBICTest->init_schema();
 
@@ -43,3 +43,46 @@
 # test that related deletion with limit condition works
 $a2_cds->search ({}, { rows => 1})->delete;
 is ($cdrs->count, $total_cds -= 1, 'related + limit delete ok');
+
+my $tkfk = $schema->resultset('FourKeys_to_TwoKeys');
+
+my ($fa, $fb) = $tkfk->related_resultset ('fourkeys')->populate ([
+  [qw/foo bar hello goodbye sensors/],
+  [qw/1   1   1     1       a      /],
+  [qw/2   2   2     2       b      /],
+]);
+
+# This is already provided by DBICTest
+#my ($ta, $tb) = $tkfk->related_resultset ('twokeys')->populate ([
+#  [qw/artist  cd /],
+#  [qw/1       1  /],
+#  [qw/2       2  /],
+#]);
+my ($ta, $tb) = $schema->resultset ('TwoKeys')
+                  ->search ( [ { artist => 1, cd => 1 }, { artist => 2, cd => 2 } ])
+                    ->all;
+
+my $tkfk_cnt = $tkfk->count;
+
+my $non_void_ctx = $tkfk->populate ([
+  { autopilot => 'a', fourkeys =>  $fa, twokeys => $ta },
+  { autopilot => 'b', fourkeys =>  $fb, twokeys => $tb },
+  { autopilot => 'x', fourkeys =>  $fa, twokeys => $tb },
+  { autopilot => 'y', fourkeys =>  $fb, twokeys => $ta },
+]);
+is ($tkfk->count, $tkfk_cnt += 4, 'FourKeys_to_TwoKeys populated succesfully');
+
+my $sub_rs = $tkfk->search (
+  [ 
+    { map { $_ => 1 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
+    { map { $_ => 2 } qw/artist.artistid cd.cdid fourkeys.foo fourkeys.bar fourkeys.hello fourkeys.goodbye/ },
+  ],
+  {
+    join => [ 'fourkeys', { twokeys => [qw/artist cd/] } ],
+  },
+);
+
+is ($sub_rs->count, 2, 'Only two rows from fourkeys match');
+$sub_rs->delete;
+
+is ($tkfk->count, $tkfk_cnt -= 2, 'Only two rows deleted');




More information about the Bast-commits mailing list