package Test::SQL::Translator;
-# ----------------------------------------------------------------------
-# Copyright (C) 2003 The SQLFairy Authors
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307 USA
-# -------------------------------------------------------------------
-
=pod
=head1 NAME
use SQL::Translator::Schema::Constants;
use base qw(Exporter);
-use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = '1.59';
-@EXPORT = qw(
+our @EXPORT_OK;
+our $VERSION = '1.59';
+our @EXPORT = qw(
schema_ok
table_ok
field_ok
my ($hashref, $object_type) = @_;
if ( !exists $ATTRIBUTES{ $object_type } ) {
- die "Can't add default attribs for unknown Schema "
+ die "Can't add default attribs for unknown Schema "
. "object type '$object_type'.";
}
- for my $attr (
+ for my $attr (
grep { !exists $hashref->{ $_ } }
- keys %{ $ATTRIBUTES{ $object_type } }
+ keys %{ $ATTRIBUTES{ $object_type } }
) {
$hashref->{ $attr } = $ATTRIBUTES{ $object_type }{ $attr }
}
is_deeply( [$obj->options], $test->{options},
"$t_name options are '".join(",",@{$test->{options}})."'" );
-
+
is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" );
}
is_deeply( [$obj->options], $test->{options},
"$t_name options are '".join(",",@{$test->{options}})."'" );
-
+
is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" );
}
"$t_name on_table is '$test->{on_table}'" );
is( $obj->action, $test->{action}, "$t_name action is '$test->{action}'" );
-
+
is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" );
}
is_deeply( [$obj->fields], $test->{fields},
"$t_name fields are '".join(",",@{$test->{fields}})."'" );
-
+
is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" );
}
is_deeply( [$obj->parameters], $test->{parameters},
"$t_name parameters are '".join(",",@{$test->{parameters}})."'" );
- is( $obj->comments, $test->{comments},
+ is( $obj->comments, $test->{comments},
"$t_name comments is '$test->{comments}'" );
is( $obj->owner, $test->{owner}, "$t_name owner is '$test->{owner}'" );
-
+
is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" );
}
# Fields
if ( $arg{fields} ) {
my @fldnames = map {$_->{name}} @{$arg{fields}};
- is_deeply(
+ is_deeply(
[ map {$_->name} $obj->get_fields ],
[ @fldnames ],
"${t_name} field names are ".join(", ",@fldnames)
my $meth = "get_$plural";
my @objects = $obj->$meth;
is( scalar(@objects), scalar(@tests),
- "${t_name}$obj_name has " . scalar(@tests) . " $plural"
+ "${t_name}$obj_name has " . scalar(@tests) . " $plural"
);
for my $object (@objects) {
is( $obj->database, $test->{database},
"$t_name database is '$test->{database}'" );
-
+
is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" );
is( $obj->is_valid, $test->{is_valid},
for my $module (@modules) {
eval "use $module;";
- if ($@ && $@ =~ /Can't locate (\S+)/) {
+ next if !$@;
+
+ if ($@ =~ /Can't locate (\S+)/) {
my $mod = $1;
$mod =~ s/\.pm$//;
$mod =~ s#/#::#g;
push @errors, $mod;
}
+ elsif ($@ =~ /([\w\:]+ version [\d\.]+) required.+?this is only version/) {
+ push @errors, $1;
+ }
}
if (@errors) {
join ", ", @errors;
plan skip_all => $msg;
}
- else {
+ return unless defined $ntests;
+
+ if ($ntests ne 'no_plan') {
plan tests => $ntests;
}
+ else {
+ plan 'no_plan';
+ }
}
1; # compile please ===========================================================
The data structures given to the test subs don't have to include all the
possible values, only the ones you expect to have changed. Any left out will be
-tested to make sure they are still at their default value. This is a usefull
+tested to make sure they are still at their default value. This is a useful
check that you your parser hasn't accidentally set schema values you didn't
expect it to.
If one of C<SQL::Translator::Parser::MySQL>'s dependencies does not exist,
then the test will be skipped.
+Instead of a number of tests, you can pass C<undef> if you're using
+C<done_testing()>, or C<'no_plan'> if you don't want a plan at all.
+
=head1 EXPORTS
table_ok, field_ok, constraint_ok, index_ok, view_ok, trigger_ok, procedure_ok,
=item Test skipping
-As the test subs wrap up lots of tests in one call you can't skip idividual
+As the test subs wrap up lots of tests in one call you can't skip individual
tests only whole sets e.g. a whole table or field.
We could add skip_* items to the test hashes to allow per test skips. e.g.
=back
-=head1 BUGS
-
=head1 AUTHOR
-Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
+Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
Darren Chamberlain <darren@cpan.org>.
Thanks to Ken Y. Clark for the original table and field test code taken from
projects / dbsrgits/SQL-Translator.git / blobdiff