X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F23dumpmore.t;h=9f31abdd3b5821575fddd9ad53361ce93c44d7a5;hb=05c54730e9cd481cf4dd21806e2d76ad8409eb2b;hp=d9efd361d597d537e6748c18f306a11cecf14541;hpb=ff746964a437e42a7edfd99ec68d366442822c9d;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/23dumpmore.t b/t/23dumpmore.t index d9efd36..9f31abd 100644 --- a/t/23dumpmore.t +++ b/t/23dumpmore.t @@ -6,10 +6,6 @@ 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 => 140); - my $DUMP_PATH = './t/_dump'; sub dump_directly { @@ -30,7 +26,7 @@ sub dump_directly { $schema_class->storage->disconnect if !$err && $schema_class->storage; undef *{$schema_class}; - is($err, $tdata{error}); + check_error($err, $tdata{error}); return @warns; } @@ -38,7 +34,8 @@ sub dump_directly { sub dump_dbicdump { my %tdata = @_; - my @cmd = qw(./script/dbicdump); + # 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"; @@ -46,19 +43,47 @@ sub dump_dbicdump { push @cmd, $tdata{classname}, $make_dbictest_db::dsn; + # make sure our current @INC gets used by dbicdump + use Config; + local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, ($ENV{PERL5LIB} || ''); + my ($in, $out, $err); my $pid = open3($in, $out, $err, @cmd); - my @warns = <$out>; + my @out = <$out>; waitpid($pid, 0); + my ($error, @warns); + + if ($? >> 8 != 0) { + $error = $out[0]; + check_error($error, $tdata{error}); + } + else { + @warns = @out; + } + return @warns; } +sub check_error { + my ($got, $expected) = @_; + + return unless $got && $expected; + + if (ref $expected eq 'Regexp') { + like $got, $expected, 'error matches expected pattern'; + return; + } + + is $got, $expected, 'error matches'; +} + 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)); @@ -73,6 +98,7 @@ sub test_dumps { my $schema_class = $tdata{classname}; my $check_warns = $tdata{warnings}; is(@warns, @$check_warns, "$schema_class warning count"); + for(my $i = 0; $i <= $#$check_warns; $i++) { like($warns[$i], $check_warns->[$i], "$schema_class warning $i"); } @@ -123,6 +149,42 @@ sub append_to_class { rmtree($DUMP_PATH, 1, 1); +# test loading external content +do_dump_test( + classname => 'DBICTest::Schema::13', + options => { }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::Schema::13 to directory /, + qr/Schema dump completed/, + ], + regexes => { + Foo => [ +qr/package DBICTest::Schema::13::Foo;\nour \$skip_me = "bad mojo";\n1;/ + ], + }, +); + +# test skipping external content +do_dump_test( + classname => 'DBICTest::Schema::14', + options => { skip_load_external => 1 }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::Schema::14 to directory /, + qr/Schema dump completed/, + ], + neg_regexes => { + Foo => [ +qr/package DBICTest::Schema::14::Foo;\nour \$skip_me = "bad mojo";\n1;/ + ], + }, +); + +rmtree($DUMP_PATH, 1, 1); + +# test out the POD + do_dump_test( classname => 'DBICTest::DumpMore::1', options => { }, @@ -137,14 +199,26 @@ do_dump_test( qr/->load_classes/, ], Foo => [ - qr/package DBICTest::DumpMore::1::Foo;/, - qr/->set_primary_key/, - qr/1;\n$/, +qr/package DBICTest::DumpMore::1::Foo;/, +qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/, +qr/=head1 ACCESSORS\n\n/, +qr/=head2 fooid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/, +qr/=head2 footext\n\n data_type: TEXT\n default_value: undef\n is_nullable: 1\n size: undef\n\n/, +qr/->set_primary_key/, +qr/=head1 RELATIONS\n\n/, +qr/=head2 bars\n\nType: has_many\n\nRelated object: L\n\n=cut\n\n/, +qr/1;\n$/, ], Bar => [ - qr/package DBICTest::DumpMore::1::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, +qr/package DBICTest::DumpMore::1::Bar;/, +qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/, +qr/=head1 ACCESSORS\n\n/, +qr/=head2 barid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/, +qr/=head2 fooref\n\n data_type: INTEGER\n default_value: undef\n is_foreign_key: 1\n is_nullable: 1\n size: undef\n\n/, +qr/->set_primary_key/, +qr/=head1 RELATIONS\n\n/, +qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L\n\n=cut\n\n/, +qr/1;\n$/, ], }, ); @@ -213,6 +287,21 @@ do_dump_test( do_dump_test( classname => 'DBICTest::DumpMore::1', + options => { use_namespaces => 1, generate_pod => 0 }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + neg_regexes => { + 'Result/Foo' => [ + qr/^=/m, + ], + }, +); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', options => { use_namespaces => 1 }, error => '', warnings => [ @@ -276,6 +365,8 @@ do_dump_test( result_namespace => '+DBICTest::DumpMore::1::Res', resultset_namespace => 'RSet', default_resultset_class => 'RSetBase', + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', }, error => '', warnings => [ @@ -289,18 +380,32 @@ do_dump_test( qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/, qr/resultset_namespace => 'RSet'/, qr/default_resultset_class => 'RSetBase'/, + qr/use base 'My::SchemaBaseClass'/, ], 'Res/Foo' => [ qr/package DBICTest::DumpMore::1::Res::Foo;/, + qr/use base 'My::ResultBaseClass'/, qr/->set_primary_key/, qr/1;\n$/, ], 'Res/Bar' => [ qr/package DBICTest::DumpMore::1::Res::Bar;/, + qr/use base 'My::ResultBaseClass'/, qr/->set_primary_key/, qr/1;\n$/, ], }, ); -END { rmtree($DUMP_PATH, 1, 1); } +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1, + result_base_class => 'My::MissingResultBaseClass', + }, + error => qr/My::MissingResultBaseClass.*is not installed/, +); + +done_testing; + +END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} }