1use strict; 2use Test::More; 3use lib qw(t/lib); 4use File::Path; 5use make_dbictest_db; 6 7my $dump_path = './t/_dump'; 8 9local $SIG{__WARN__} = sub { 10 warn $_[0] unless $_[0] =~ 11 /really_erase_my_files|Dumping manual schema|Schema dump completed/; 12}; 13 14{ 15 package DBICTest::Schema::1; 16 use base qw/ DBIx::Class::Schema::Loader /; 17 __PACKAGE__->loader_options( 18 dump_directory => $dump_path, 19 ); 20} 21 22{ 23 package DBICTest::Schema::2; 24 use base qw/ DBIx::Class::Schema::Loader /; 25 __PACKAGE__->loader_options( 26 dump_directory => $dump_path, 27 really_erase_my_files => 1, 28 ); 29} 30 31plan tests => 5; 32 33rmtree($dump_path, 1, 1); 34 35eval { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }; 36ok(!$@, 'no death with dump_directory set') or diag "Dump failed: $@"; 37 38DBICTest::Schema::1->_loader_invoked(undef); 39 40SKIP: { 41 my @warnings_regexes = ( 42 qr|Dumping manual schema|, 43 qr|Schema dump completed|, 44 ); 45 46 skip "ActiveState perl produces additional warnings", scalar @warnings_regexes 47 if ($^O eq 'MSWin32'); 48 49 my @warn_output; 50 { 51 local $SIG{__WARN__} = sub { push(@warn_output, @_) }; 52 DBICTest::Schema::1->connect($make_dbictest_db::dsn); 53 } 54 55 like(shift @warn_output, $_) foreach (@warnings_regexes); 56 57 rmtree($dump_path, 1, 1); 58} 59 60eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }; 61ok(!$@, 'no death with dump_directory set (overwrite1)') 62 or diag "Dump failed: $@"; 63 64DBICTest::Schema::2->_loader_invoked(undef); 65eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }; 66ok(!$@, 'no death with dump_directory set (overwrite2)') 67 or diag "Dump failed: $@"; 68 69END { rmtree($dump_path, 1, 1); } 70