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