+use DBIx::Class::Optional::Dependencies -skip_all_without => 'deploy';
+
use strict;
use warnings;
+BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 }
+
use Test::More;
use Test::Warn;
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
-
-BEGIN {
- require DBIx::Class;
- plan skip_all =>
- 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy')
- unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')
-}
+use DBIx::Class::_Util 'sigwarn_silencer';
# Test for SQLT-related leaks
{
push @schemas, create_schema({
args => { parser_args => { $parser_args_key => $s } }
});
- } qr/\Qparser_args => {\E.+?is deprecated/,
+ } qr/\Qparser_args => {\E.+?is deprecated.+\Q@{[__FILE__]}/,
"deprecated crazy parser_arg '$parser_args_key' warned";
}
# make sure a connected instance passed via $args does not get the $dbh improperly serialized
SKIP: {
- # YAML is a build_requires dep of SQLT - it may or may not be here
- eval { require YAML } or skip "Test requires YAML.pm", 1;
+ DBIx::Class::Optional::Dependencies->skip_without( 'YAML>=0' );
lives_ok {
parser => 'SQL::Translator::Parser::YAML'
)->translate(
data => SQL::Translator->new(
- parser_args => { package => $s },
+ parser_args => { dbic_schema => $s },
parser => 'SQL::Translator::Parser::DBIx::Class',
producer => 'SQL::Translator::Producer::YAML',
)->translate
eval <<'EOE' or die $@;
END {
+ # we are in END - everything remains global
+ #
$^W = 1; # important, otherwise DBI won't trip the next fail()
$SIG{__WARN__} = sub {
fail "Unexpected global destruction warning"
lives_ok (sub {
my $sqlt_schema = do {
- local $SIG{__WARN__} = sub {
- warn @_
- unless $_[0] =~ /Ignoring relationship .+ related resultsource .+ is not registered with this schema/
- };
+ local $SIG{__WARN__} = sigwarn_silencer(
+ qr/Ignoring relationship .+ related resultsource .+ is not registered with this schema/
+ );
create_schema({ schema => $partial_schema });
};
}, 'partial schema tests successful');
}
+{
+ my $cd_rsrc = $schema->source('CD');
+ $cd_rsrc->name(\'main.cd');
+
+ my $sqlt_schema = create_schema(
+ { schema => $schema },
+ args => { ignore_constraint_names => 0, ignore_index_names => 0 }
+ );
+
+ foreach my $source_name (qw(CD)) {
+ my $table = get_table($sqlt_schema, $schema, $source_name);
+ ok(
+ !(grep {$_->name =~ m/main\./} $table->get_indices),
+ 'indices have periods stripped out'
+ );
+ ok(
+ !(grep {$_->name =~ m/main\./} $table->get_constraints),
+ 'constraints have periods stripped out'
+ );
+ }
+}
+
done_testing;
sub create_schema {