From: Peter Rabbitson Date: Sat, 11 Sep 2010 01:12:19 +0000 (+0200) Subject: Overhaul of test warning handling - mask off as little as possible X-Git-Tag: 0.07002~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=c38ec663ec7b40c65613e5ec26542672b15cdbde Overhaul of test warning handling - mask off as little as possible --- diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 01f925f..6fb5c3f 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -18,7 +18,7 @@ use Class::Unload; use Class::Inspector (); use Scalar::Util 'looks_like_number'; use File::Slurp 'slurp'; -use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed/; +use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_without_redefine_warnings/; use DBIx::Class::Schema::Loader::Optional::Dependencies (); use Try::Tiny; use DBIx::Class (); @@ -844,14 +844,7 @@ sub _load_external { $code = $self->_rewrite_old_classnames($code); if ($self->dynamic) { # load the class too - # kill redefined warnings - my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; - local $SIG{__WARN__} = sub { - $warn_handler->(@_) - unless $_[0] =~ /^Subroutine \S+ redefined/; - }; - eval $code; - die $@ if $@; + eval_without_redefine_warnings($code); } $self->_ext_stmt($class, @@ -892,14 +885,7 @@ been used by an older version of the Loader. * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the new name of the Result. EOF - # kill redefined warnings - my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; - local $SIG{__WARN__} = sub { - $warn_handler->(@_) - unless $_[0] =~ /^Subroutine \S+ redefined/; - }; - eval $code; - die $@ if $@; + eval_without_redefine_warnings($code); } chomp $code; @@ -1125,12 +1111,9 @@ sub _reload_class { delete $INC{ $class_path }; # kill redefined warnings - my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; - local $SIG{__WARN__} = sub { - $warn_handler->(@_) - unless $_[0] =~ /^Subroutine \S+ redefined/; + eval { + eval_without_redefine_warnings ("require $class"); }; - eval "require $class;"; die "Failed to reload class $class: $@" if $@; } diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm index 19d20fa..b3c9b4a 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI.pm @@ -285,7 +285,12 @@ sub _columns_info_for { if ($dbh->can('column_info')) { my %result; eval { - my $sth = eval { local $SIG{__WARN__} = sub {}; $dbh->column_info( undef, $self->db_schema, $table, '%' ); }; + my $sth = do { + # FIXME - seems to only warn on MySQL, and even then the output is valuable + # need to figure out how no to mask it away (and still have tests pass) + local $SIG{__WARN__} = sub {}; + $dbh->column_info( undef, $self->db_schema, $table, '%' ); + }; while ( my $info = $sth->fetchrow_hashref() ){ my $column_info = {}; $column_info->{data_type} = lc $info->{TYPE_NAME}; @@ -313,7 +318,8 @@ sub _columns_info_for { } $sth->finish; }; - return \%result if !$@ && scalar keys %result; + + return \%result if !$@ && scalar keys %result; } my %result; diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm index 7a066be..4826934 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm @@ -189,6 +189,7 @@ sub _table_fk_info_builder { sub _table_uniq_info { my ($self, $table) = @_; + # FIXME - remove blind mask (can't test sybase yet) local $SIG{__WARN__} = sub {}; my $dbh = $self->schema->storage->dbh; diff --git a/lib/DBIx/Class/Schema/Loader/Utils.pm b/lib/DBIx/Class/Schema/Loader/Utils.pm index 5371dab..8b52e17 100644 --- a/lib/DBIx/Class/Schema/Loader/Utils.pm +++ b/lib/DBIx/Class/Schema/Loader/Utils.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Exporter 'import'; -our @EXPORT_OK = qw/split_name dumper dumper_squashed/; +our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_without_redefine_warnings/; use constant BY_CASE_TRANSITION => qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/; @@ -37,5 +37,17 @@ sub dumper_squashed($) { return $dd->Values([ $val ])->Dump; } +sub eval_without_redefine_warnings { + my $code = shift; + + my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; + local $SIG{__WARN__} = sub { + $warn_handler->(@_) + unless $_[0] =~ /^Subroutine \S+ redefined/; + }; + eval $code; + die $@ if $@; +} + 1; # vim:et sts=4 sw=4 tw=0: diff --git a/t/12pg_common.t b/t/12pg_common.t index e40cbd6..3b7baa8 100644 --- a/t/12pg_common.t +++ b/t/12pg_common.t @@ -15,6 +15,9 @@ my $tester = dbixcsl_common_tests->new( user => $user, password => $password, loader_options => { preserve_case => 1 }, + connect_info_opts => { + on_connect_do => [ 'SET client_min_messages=WARNING' ], + }, quote_char => '"', data_types => { # http://www.postgresql.org/docs/7.4/interactive/datatype.html diff --git a/t/16mssql_common.t b/t/16mssql_common.t index bef5329..7455727 100644 --- a/t/16mssql_common.t +++ b/t/16mssql_common.t @@ -2,6 +2,7 @@ use strict; use warnings; use Test::More; use Test::Exception; +use Test::Warn; # use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else BEGIN { @@ -256,13 +257,8 @@ my $tester = dbixcsl_common_tests->new( my $dbh = $schema->storage->dbh; $dbh->do("DROP TABLE mssql_loader_test3"); - my @warnings; - { - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - $schema->rescan; - } - ok ((grep /^Bad table or view 'mssql_loader_test4'/, @warnings), - 'bad view ignored'); + warnings_exist { $schema->rescan } + qr/^Bad table or view 'mssql_loader_test4'/, 'bad view ignored'; throws_ok { $schema->resultset($monikers->{mssql_loader_test4}) diff --git a/t/18firebird_common.t b/t/18firebird_common.t index 342d885..486bea2 100644 --- a/t/18firebird_common.t +++ b/t/18firebird_common.t @@ -147,6 +147,7 @@ q{ $schema->_loader->_setup; { + # FIXME - need to remove blind trap (can not test firebird yet) local $SIG{__WARN__} = sub {}; $schema->rescan; } @@ -174,6 +175,7 @@ if (not ($dbd_interbase_dsn || $odbc_dsn)) { else { # get rid of stupid warning from InterBase/GetInfo.pm if ($dbd_interbase_dsn) { + # FIXME - need to remove blind trap (can not test firebird yet) local $SIG{__WARN__} = sub {}; require DBD::InterBase; require DBD::InterBase::GetInfo; diff --git a/t/20invocations.t b/t/20invocations.t index c74892a..51332f8 100644 --- a/t/20invocations.t +++ b/t/20invocations.t @@ -150,7 +150,7 @@ while(@invocations) { my $schema = do { local $SIG{__WARN__} = sub { - warn $_[0] unless $_[0] =~ /really_erase_my_files/ + warn $_[0] unless $_[0] =~ /Deleting existing file .+ due to 'really_erase_my_files' setting/ }; $cref->(); }; diff --git a/t/22dump.t b/t/22dump.t index 0b3a2f8..cc92d9d 100644 --- a/t/22dump.t +++ b/t/22dump.t @@ -1,5 +1,7 @@ use strict; use Test::More; +use Test::Exception; +use Test::Warn; use lib qw(t/lib); use File::Path; use make_dbictest_db; @@ -7,10 +9,6 @@ use dbixcsl_test_dir qw/$tdir/; my $dump_path = "$tdir/dump"; -local $SIG{__WARN__} = sub { - warn $_[0] unless $_[0] =~ - /really_erase_my_files|Dumping manual schema|Schema dump completed/; -}; { package DBICTest::Schema::1; @@ -29,42 +27,43 @@ local $SIG{__WARN__} = sub { ); } -plan tests => 5; +plan tests => 7; rmtree($dump_path, 1, 1); -eval { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }; -ok(!$@, 'no death with dump_directory set') or diag "Dump failed: $@"; +lives_ok { + warnings_exist { DBICTest::Schema::1->connect($make_dbictest_db::dsn) } + [ qr|^Dumping manual schema|, qr|^Schema dump completed| ]; +} 'no death with dump_directory set' or diag "Dump failed: $@"; DBICTest::Schema::1->_loader_invoked(undef); SKIP: { - my @warnings_regexes = ( - qr|Dumping manual schema|, - qr|Schema dump completed|, - ); - - skip "ActiveState perl produces additional warnings", scalar @warnings_regexes + skip "ActiveState perl produces additional warnings", 1 if ($^O eq 'MSWin32'); - my @warn_output; - { - local $SIG{__WARN__} = sub { push(@warn_output, @_) }; - DBICTest::Schema::1->connect($make_dbictest_db::dsn); - } - - like(shift @warn_output, $_) foreach (@warnings_regexes); + warnings_exist { DBICTest::Schema::1->connect($make_dbictest_db::dsn) } + [ qr|^Dumping manual schema|, qr|^Schema dump completed| ]; rmtree($dump_path, 1, 1); } -eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }; -ok(!$@, 'no death with dump_directory set (overwrite1)') - or diag "Dump failed: $@"; +lives_ok { + warnings_exist { DBICTest::Schema::2->connect($make_dbictest_db::dsn) } + [ qr|^Dumping manual schema|, qr|^Schema dump completed| ]; +} 'no death with dump_directory set (overwrite1)' or diag "Dump failed: $@"; DBICTest::Schema::2->_loader_invoked(undef); -eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }; -ok(!$@, 'no death with dump_directory set (overwrite2)') - or diag "Dump failed: $@"; + +lives_ok { + warnings_exist { DBICTest::Schema::2->connect($make_dbictest_db::dsn) } + [ + qr/^Dumping manual schema/, + qr|^Deleting .+Schema/2.+ due to 'really_erase_my_files'|, + qr|^Deleting .+Schema/2/Result/Foo.+ due to 'really_erase_my_files'|, + qr|^Deleting .+Schema/2/Result/Bar.+ due to 'really_erase_my_files'|, + qr/^Schema dump completed/ + ]; +} 'no death with dump_directory set (overwrite2)' or diag "Dump failed: $@"; END { rmtree($dump_path, 1, 1); } diff --git a/t/25backcompat.t b/t/25backcompat.t index 7a92fbe..2f2940d 100644 --- a/t/25backcompat.t +++ b/t/25backcompat.t @@ -892,7 +892,7 @@ sub run_loader { my @connect_info = $make_dbictest_db_with_unique::dsn; my @loader_warnings; - local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; + local $SIG{__WARN__} = sub { push(@loader_warnings, @_); }; eval qq{ package $SCHEMA_CLASS; use base qw/DBIx::Class::Schema::Loader/; diff --git a/t/40overwrite_modifications.t b/t/40overwrite_modifications.t index 13154dd..20af920 100644 --- a/t/40overwrite_modifications.t +++ b/t/40overwrite_modifications.t @@ -1,6 +1,7 @@ use strict; -use Test::More tests => 3; +use Test::More tests => 5; use Test::Exception; +use Test::Warn; use lib qw(t/lib); use make_dbictest_db; @@ -23,8 +24,8 @@ ok( -f $foopm, 'looks like it dumped' ); open my $in, '<', $foopm or die "$! reading $foopm"; my ($tfh,$temp) = tempfile( UNLINK => 1); while(<$in>) { - s/"bars"/"somethingelse"/; - print $tfh $_; + s/"bars"/"somethingelse"/; + print $tfh $_; } close $tfh; copy( $temp, $foopm ); @@ -45,16 +46,14 @@ sub dump_schema { # need to poke _loader_invoked in order to be able to rerun the # loader multiple times. DBICTest::Schema::Overwrite_modifications->_loader_invoked(0) - if @DBICTest::Schema::Overwrite_modifications::ISA; - - local $SIG{__WARN__} = sub { - warn @_ - unless $_[0] =~ /^Dumping manual schema|^Schema dump completed/; - }; - DBIx::Class::Schema::Loader::make_schema_at( 'DBICTest::Schema::Overwrite_modifications', - { dump_directory => $tempdir, - @_, - }, - [ $make_dbictest_db::dsn ], - ); + if @DBICTest::Schema::Overwrite_modifications::ISA; + + my $args = \@_; + + warnings_exist { + DBIx::Class::Schema::Loader::make_schema_at( 'DBICTest::Schema::Overwrite_modifications', + { dump_directory => $tempdir, @$args }, + [ $make_dbictest_db::dsn ], + ); + } [qr/^Dumping manual schema/, qr/^Schema dump completed/ ]; } diff --git a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm index 6edbe61..9e2b967 100644 --- a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm +++ b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm @@ -542,12 +542,6 @@ sub run_tests { ); { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - my $dbh = $self->dbconnect(1); $dbh->do($_) for @statements_rescan; $dbh->disconnect; @@ -582,6 +576,9 @@ sub dbconnect { if ($self->{dsn} =~ /^[^:]+:SQLite:/) { $dbh->do ('PRAGMA synchronous = OFF'); } + elsif ($self->{dsn} =~ /^[^:]+:Pg:/) { + $dbh->do ('SET client_min_messages=WARNING'); + } die "Failed to connect to database: $DBI::errstr" if !$dbh; @@ -908,12 +905,6 @@ sub create { my $dbh = $self->dbconnect(1); - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - $dbh->do($_) for (@statements); unless($self->{skip_rels}) { # hack for now, since DB2 doesn't like inline comments, and we need diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index e19c3d8..41bfdd3 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -124,17 +124,8 @@ sub run_only_extra_tests { $self->drop_extra_tables_only; my $dbh = $self->dbconnect(1); - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - - - $dbh->do($_) for @{ $self->{extra}{create} || [] }; - $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []}; - } + $dbh->do($_) for @{ $self->{extra}{create} || [] }; + $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []}; $self->{_created} = 1; my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] }; @@ -160,11 +151,7 @@ sub drop_extra_tables_only { my $dbh = $self->dbconnect(0); - { - local $SIG{__WARN__} = sub {}; # postgres notices - $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; - } - + $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) { @@ -223,7 +210,7 @@ sub setup_schema { my $file_count; { my @loader_warnings; - local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; + local $SIG{__WARN__} = sub { push(@loader_warnings, @_); }; eval qq{ package $schema_class; use base qw/DBIx::Class::Schema::Loader/; @@ -936,24 +923,15 @@ sub test_schema { $conn->storage->disconnect; # needed for Firebird and Informix my $dbh = $self->dbconnect(1); - - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - - $dbh->do($_) for @statements_rescan; - } - + $dbh->do($_) for @statements_rescan; $dbh->disconnect; sleep 1; my @new = do { - # kill the 'Dumping manual schema' warnings - local $SIG{__WARN__} = sub {}; + local $SIG{__WARN__} = sub { warn @_ + unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed/ + }; $conn->rescan; }; is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan"); @@ -984,7 +962,9 @@ sub test_schema { $conn->storage->dbh->do("DROP TABLE loader_test30"); @new = do { - local $SIG{__WARN__} = sub {}; + local $SIG{__WARN__} = sub { warn @_ + unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed/ + }; $conn->rescan; }; is_deeply(\@new, [], 'no new tables on rescan'); @@ -1037,16 +1017,9 @@ sub test_preserve_case { my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); # open quote, close quote - my $dbh = $conn->storage->dbh; - - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; + my $dbh = $self->dbconnect; - $dbh->do($_) for ( + $dbh->do($_) for ( qq| CREATE TABLE ${oqt}LoaderTest40${cqt} ( ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY, @@ -1062,17 +1035,19 @@ qq| |, qq| INSERT INTO ${oqt}LoaderTest40${cqt} VALUES (1, 'foo') |, qq| INSERT INTO ${oqt}LoaderTest41${cqt} VALUES (1, 1) |, - ); - } + ); $conn->storage->disconnect; local $conn->_loader->{preserve_case} = 1; $conn->_loader->_setup; + { - local $SIG{__WARN__} = sub {}; + local $SIG{__WARN__} = sub { warn @_ + unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed/ + }; $conn->rescan; - } + }; if (not $self->{skip_rels}) { is $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar, 'foo', @@ -1610,12 +1585,6 @@ sub create { my $dbh = $self->dbconnect(1); - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - $dbh->do($_) foreach (@statements); $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] }); @@ -1722,10 +1691,7 @@ sub drop_tables { for (1,2) { my $dbh = $self->dbconnect(0); - { - local $SIG{__WARN__} = sub {}; # postgres notices - $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; - } + $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };