use_namespaces is now default, still needs the upgrade code

[dbsrgits/DBIx-Class-Schema-Loader.git] / t / 23dumpmore.t

diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 6455ad0..c27973e 100644 (file)
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -2,23 +2,24 @@ use strict;
 use Test::More;
 use lib qw(t/lib);
 use File::Path;
+use IPC::Open3;
 use make_dbictest_db;
 require DBIx::Class::Schema::Loader;
 
-$^O eq 'MSWin32'
-    ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
-    : plan(tests => 85);
+$^O eq 'MSWin32' && plan(skip_all =>
+"ActiveState perl produces additional warnings, and this test uses unix paths"
+);
 
 my $DUMP_PATH = './t/_dump';
 
-sub do_dump_test {
+sub dump_directly {
     my %tdata = @_;
 
     my $schema_class = $tdata{classname};
 
     no strict 'refs';
     @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
-    $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});
+    $schema_class->loader_options(%{$tdata{options}});
 
     my @warns;
     eval {
@@ -31,10 +32,54 @@ sub do_dump_test {
 
     is($err, $tdata{error});
 
+    return @warns;
+}
+
+sub dump_dbicdump {
+    my %tdata = @_;
+
+    # use $^X so we execute ./script/dbicdump with the same perl binary that the tests were executed with
+    my @cmd = ($^X, qw(./script/dbicdump));
+
+    while (my ($opt, $val) = each(%{ $tdata{options} })) {
+        push @cmd, '-o', "$opt=$val";
+    }
+
+    push @cmd, $tdata{classname}, $make_dbictest_db::dsn;
+
+    # make sure our current @INC gets used by dbicdump
+    local $ENV{PERL5LIB} = join ":", @INC, $ENV{PERL5LIB};
+
+    my ($in, $out, $err);
+    my $pid = open3($in, $out, $err, @cmd);
+
+    my @warns = <$out>;
+    waitpid($pid, 0);
+
+    return @warns;
+}
+
+sub do_dump_test {
+    my %tdata = @_;
+    
+    $tdata{options}{dump_directory} = $DUMP_PATH;
+    $tdata{options}{use_namespaces} ||= 0;
+
+    for my $dumper (\&dump_directly, \&dump_dbicdump) {
+        test_dumps(\%tdata, $dumper->(%tdata));
+    }
+}
+
+sub test_dumps {
+    my ($tdata, @warns) = @_;
+
+    my %tdata = %{$tdata};
+
+    my $schema_class = $tdata{classname};
     my $check_warns = $tdata{warnings};
-    is(@warns, @$check_warns);
+    is(@warns, @$check_warns, "$schema_class warning count");
     for(my $i = 0; $i <= $#$check_warns; $i++) {
-        like($warns[$i], $check_warns->[$i]);
+        like($warns[$i], $check_warns->[$i], "$schema_class warning $i");
     }
 
     my $file_regexes = $tdata{regexes};
@@ -59,7 +104,8 @@ sub dump_file_like {
     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
     my $contents = do { local $/; <$dumpfh>; };
     close($dumpfh);
-    like($contents, $_) for @_;
+    my $num = 1;
+    like($contents, $_, "like $path " . $num++) for @_;
 }
 
 sub dump_file_not_like {
@@ -67,7 +113,8 @@ sub dump_file_not_like {
     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
     my $contents = do { local $/; <$dumpfh>; };
     close($dumpfh);
-    unlike($contents, $_) for @_;
+    my $num = 1;
+    unlike($contents, $_, "unlike $path ". $num++) for @_;
 }
 
 sub append_to_class {
@@ -96,11 +143,15 @@ do_dump_test(
         ],
         Foo => [
             qr/package DBICTest::DumpMore::1::Foo;/,
+            qr/=head1 NAME/,
+            qr/=head1 ACCESSORS/,
             qr/->set_primary_key/,
             qr/1;\n$/,
         ],
         Bar => [
             qr/package DBICTest::DumpMore::1::Bar;/,
+            qr/=head1 NAME/,
+            qr/=head1 ACCESSORS/,
             qr/->set_primary_key/,
             qr/1;\n$/,
         ],
@@ -266,4 +317,6 @@ do_dump_test(
     },
 );
 
+done_testing;
+
 END { rmtree($DUMP_PATH, 1, 1); }