[Bast-commits] r5156 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/ResultSourceProxy t/cdbi-t t/testlib

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2008-11-17 02:48:57 +0000 (Mon, 17 Nov 2008)
New Revision: 5156

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSourceProxy/Table.pm
   DBIx-Class/0.08/trunk/t/cdbi-t/02-Film.t
   DBIx-Class/0.08/trunk/t/cdbi-t/15-accessor.t
   DBIx-Class/0.08/trunk/t/cdbi-t/23-cascade.t
   DBIx-Class/0.08/trunk/t/testlib/MyBase.pm
Log:
Silence cdbi tests like everything else

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSourceProxy/Table.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSourceProxy/Table.pm	2008-11-17 02:09:18 UTC (rev 5155)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSourceProxy/Table.pm	2008-11-17 02:48:57 UTC (rev 5156)
@@ -40,7 +40,7 @@
 
     $class->result_source_instance($table);
 
-    if ($class->can('schema_instance')) {
+    if ($class->can('schema_instance') && $class->schema_instance) {
         $class =~ m/([^:]+)$/;
         $class->schema_instance->register_class($class, $class);
     }

Modified: DBIx-Class/0.08/trunk/t/cdbi-t/02-Film.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi-t/02-Film.t	2008-11-17 02:09:18 UTC (rev 5155)
+++ DBIx-Class/0.08/trunk/t/cdbi-t/02-Film.t	2008-11-17 02:48:57 UTC (rev 5156)
@@ -231,17 +231,26 @@
 );
 
 # Test that a disconnect doesnt harm anything.
-Film->db_Main->disconnect;
- at films = Film->search({ Rating => 'NC-17' });
-ok(@films == 1 && $films[0]->id eq $gone->id, 'auto reconnection');
+{
+    # SQLite is loud on disconnect/reconnect. 
+    # This is solved in DBIC but not in ContextualFetch
+    local $SIG{__WARN__} = sub {
+      warn @_ unless $_[0] =~
+        /active statement handles|inactive database handle/;
+    };
 
-# Test discard_changes().
-my $orig_director = $btaste->Director;
-$btaste->Director('Lenny Bruce');
-is($btaste->Director, 'Lenny Bruce', 'set new Director');
-$btaste->discard_changes;
-is($btaste->Director, $orig_director, 'discard_changes()');
+    Film->db_Main->disconnect;
+    @films = Film->search({ Rating => 'NC-17' });
+    ok(@films == 1 && $films[0]->id eq $gone->id, 'auto reconnection');
 
+    # Test discard_changes().
+    my $orig_director = $btaste->Director;
+    $btaste->Director('Lenny Bruce');
+    is($btaste->Director, 'Lenny Bruce', 'set new Director');
+    $btaste->discard_changes;
+    is($btaste->Director, $orig_director, 'discard_changes()');
+}
+
 SKIP: {
 	skip "ActiveState perl produces additional warnings", 3
           if ($^O eq 'MSWin32');

Modified: DBIx-Class/0.08/trunk/t/cdbi-t/15-accessor.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi-t/15-accessor.t	2008-11-17 02:09:18 UTC (rev 5155)
+++ DBIx-Class/0.08/trunk/t/cdbi-t/15-accessor.t	2008-11-17 02:48:57 UTC (rev 5156)
@@ -114,6 +114,9 @@
     like $@, qr/film/, "no hasa film";
 
     eval {
+        local $SIG{__WARN__} = sub {
+            warn @_ unless $_[0] =~ /Query returned more than one row/;
+        };
         ok my $f = $ac->movie, "hasa movie";
         isa_ok $f, "Film";
         is $f->id, $bt->id, " - Bad Taste";

Modified: DBIx-Class/0.08/trunk/t/cdbi-t/23-cascade.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi-t/23-cascade.t	2008-11-17 02:09:18 UTC (rev 5155)
+++ DBIx-Class/0.08/trunk/t/cdbi-t/23-cascade.t	2008-11-17 02:48:57 UTC (rev 5156)
@@ -1,5 +1,6 @@
 use strict;
 use Test::More;
+use Data::Dumper;
 
 BEGIN {
   eval "use DBIx::Class::CDBICompat;";
@@ -48,7 +49,8 @@
     is $dir->nasties, 1, "We have one nasty";
 
     ok $dir->delete;
-    ok +Film->retrieve("Alligator"), "has_many with @{[ keys %$args ]} => @{[ values %$args ]}";
+    local $Data::Dumper::Terse = 1;
+    ok +Film->retrieve("Alligator"), 'has_many with ' . Dumper ($args);;
     $kk->delete;
 }
 

Modified: DBIx-Class/0.08/trunk/t/testlib/MyBase.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/MyBase.pm	2008-11-17 02:09:18 UTC (rev 5155)
+++ DBIx-Class/0.08/trunk/t/testlib/MyBase.pm	2008-11-17 02:48:57 UTC (rev 5156)
@@ -8,7 +8,8 @@
 
 use vars qw/$dbh/;
 
-my @connect = ("dbi:mysql:test", "", "");
+# temporary, might get switched to the new test framework someday
+my @connect = ("dbi:mysql:test", "", "", { PrintError => 0});
 
 $dbh = DBI->connect(@connect) or die DBI->errstr;
 my @table;