[Bast-commits] r7969 - in branches/DBIx-Class-Schema-Loader/current: . lib/DBIx/Class/Schema/Loader t/lib

caelum at dev.catalyst.perl.org caelum at dev.catalyst.perl.org
Sat Nov 28 07:36:03 GMT 2009


Author: caelum
Date: 2009-11-28 07:36:00 +0000 (Sat, 28 Nov 2009)
New Revision: 7969

Modified:
   branches/DBIx-Class-Schema-Loader/current/Changes
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
Log:
add test for norewrite

Modified: branches/DBIx-Class-Schema-Loader/current/Changes
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Changes	2009-11-27 00:38:11 UTC (rev 7968)
+++ branches/DBIx-Class-Schema-Loader/current/Changes	2009-11-28 07:36:00 UTC (rev 7969)
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - added test for norewrite feature
         - fix default_value for MSSQL
 
 0.04999_10  2009-10-31 12:28:53

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2009-11-27 00:38:11 UTC (rev 7968)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2009-11-28 07:36:00 UTC (rev 7969)
@@ -423,6 +423,9 @@
 sub _reload_classes {
     my ($self, @tables) = @_;
 
+    # so that we don't repeat custom sections
+    @INC = grep $_ ne $self->dump_directory, @INC;
+
     $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
 
     unshift @INC, $self->dump_directory;

Modified: branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm	2009-11-27 00:38:11 UTC (rev 7968)
+++ branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm	2009-11-28 07:36:00 UTC (rev 7969)
@@ -8,6 +8,8 @@
 use Class::Unload;
 use File::Path;
 use DBI;
+use Digest::MD5;
+use File::Find 'find';
 
 my $DUMP_DIR = './t/_common_dump';
 rmtree $DUMP_DIR;
@@ -54,7 +56,7 @@
 sub run_tests {
     my $self = shift;
 
-    plan tests => 3 + 134 + ($self->{extra}->{count} || 0);
+    plan tests => 3 + 135 + ($self->{extra}->{count} || 0);
 
     $self->create();
 
@@ -616,11 +618,8 @@
         }
     }
 
-    # rescan test
+    # rescan and norewrite test
     SKIP: {
-        skip $self->{skip_rels}, 4 if $self->{skip_rels};
-        skip "Can't rescan dumped schema", 4 if $self->{dump};
-
         my @statements_rescan = (
             qq{
                 CREATE TABLE loader_test30 (
@@ -633,15 +632,47 @@
             q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) },
         );
 
+        # get md5
+        my $digest  = Digest::MD5->new;
+
+        my $find_cb = sub {
+            return if -d;
+            return if $_ eq 'LoaderTest30.pm';
+
+            open my $fh, '<', $_ or die "Could not open $_ for reading: $!";
+            binmode $fh;
+            $digest->addfile($fh);
+        };
+
+        find $find_cb, $DUMP_DIR;
+
+        my $before_digest = $digest->digest;
+
         my $dbh = $self->dbconnect(1);
         $dbh->do($_) for @statements_rescan;
         $dbh->disconnect;
 
-        my @new = $conn->rescan;
+        sleep 1;
+
+        my @new = do {
+            # kill the 'Dumping manual schema' warnings
+            local $SIG{__WARN__} = sub {};
+            $conn->rescan;
+        };
         is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
 
+        $digest = Digest::MD5->new;
+        find $find_cb, $DUMP_DIR;
+        my $after_digest = $digest->digest;
+
+        is $before_digest, $after_digest,
+            'dumped files are not rewritten when there is no modification';
+
         my $rsobj30   = $conn->resultset('LoaderTest30');
         isa_ok($rsobj30, 'DBIx::Class::ResultSet');
+
+        skip 'no rels', 2 if $self->{skip_rels};
+
         my $obj30 = $rsobj30->find(123);
         isa_ok( $obj30->loader_test2, $class2);
 




More information about the Bast-commits mailing list