use strict;
use Test::More qw/no_plan/;
use Test::Exception;
-use Test::SQL::Translator qw(maybe_plan);
+use Test::Differences;
use FindBin qw/$Bin/;
use SQL::Translator;
+use SQL::Translator::Utils qw/ddl_parser_instance/;
+
### Set $ENV{SQLTTEST_RT_DEBUG} = 1 for more output
# What tests to run - parser/producer name, and optional args
my $plan = [
{
+ engine => 'XML',
+ req => 'XML::LibXML 1.69',
+ no_grammar => 1,
+ },
+ {
+ engine => 'YAML',
+ no_grammar => 1,
+ },
+
+ {
engine => 'SQLite',
producer_args => {},
parser_args => {},
parser_args => {},
},
{
- engine => 'Oracle',
+ engine => 'SQLServer',
producer_args => {},
parser_args => {},
},
+
{
- engine => 'SQLServer',
+ engine => 'Oracle',
producer_args => {},
parser_args => {},
+ todo => 'Needs volunteers',
},
{
engine => 'Sybase',
producer_args => {},
parser_args => {},
+ todo => 'Needs volunteers',
},
{
engine => 'DB2',
producer_args => {},
parser_args => {},
+ todo => 'Needs volunteers',
},
# There is no Access producer
# This data file has the right mix of table/view/procedure/trigger
# definitions, and lists enough quirks to trip up most combos
-# I am not sure if augmenting it will break other tests - experiment
-my $base_file = "$Bin/data/xml/schema.xml";
+my $base_file = "$Bin/data/roundtrip_autogen.yaml";
+open (my $base_fh, '<', $base_file) or die "$base_file: $!";
my $base_t = SQL::Translator->new;
-$base_t->$_ (1) for qw/add_drop_table no_comments/;
+$base_t->$_ (1) for qw/add_drop_table no_comments quote_identifiers/;
my $base_schema = $base_t->translate (
- parser => 'XML',
- file => $base_file,
+ parser => 'YAML',
+ data => do { local $/; <$base_fh>; },
) or die $base_t->error;
+#assume there is at least one table
+my $string_re = {
+ XML => qr/<tables>\s*<table/,
+ YAML => qr/\A---\n.+tables\:/s,
+ SQL => qr/^\s*CREATE TABLE/m,
+};
+
for my $args (@$plan) {
+ SKIP: {
+ $args->{name} ||= $args->{engine};
+
+ my @req = ref $args->{req} ? @{$args->{req}} : $args->{req}||();
+ my @missing;
+ for (@req) {
+ eval "use $_ ()";
+ push @missing, $_ if ($@);
+ }
+ if (@missing) {
+ skip sprintf ('Need %s for %s roundtrip test',
+ join (', ', @missing),
+ $args->{name},
+ );
+ }
- $args->{name} ||= $args->{engine};
+ use_ok("SQL::Translator::Producer::$args->{engine}");
+ use_ok("SQL::Translator::Parser::$args->{engine}");
- lives_ok (
- sub { check_roundtrip ($args, $base_schema) },
- "Round trip for $args->{name} did not throw an exception",
- );
+ ok(ddl_parser_instance($args->{engine}), 'Got proper parser instance')
+ unless $args->{no_grammar};
+
+ TODO: {
+ local $TODO = $args->{todo} if $args->{todo};
+
+ no warnings 'once';
+ # silence PR::D from spewing on STDERR
+ local $::RD_ERRORS = 0 if $args->{todo};
+ local $::RD_WARN = 0 if $args->{todo};
+ local $::RD_HINT = 0 if $args->{todo};
+
+ lives_ok (
+ sub { check_roundtrip ($args, $base_schema) },
+ "Round trip for $args->{name} did not throw an exception",
+ );
+ }
+ }
}
my ($args, $base_schema) = @_;
my $base_t = $base_schema->translator;
-# create some sql from the submitted schema
- my $base_sql = $base_t->translate (
+# create some output from the submitted schema
+ my $base_out = $base_t->translate (
data => $base_schema,
producer => $args->{engine},
producer_args => $args->{producer_args},
);
like (
- $base_sql,
- qr/^\s*CREATE TABLE/m, #assume there is at least one create table statement
+ $base_out,
+ $string_re->{$args->{engine}} || $string_re->{SQL},
"Received some meaningful output from the first $args->{name} production",
- ) or diag ( _gen_diag ($base_t->error) );
+ ) or do {
+ diag ( _gen_diag ($base_t->error) );
+ return;
+ };
# parse the sql back
my $parser_t = SQL::Translator->new;
- $parser_t->$_ (1) for qw/add_drop_table no_comments/;
+ $parser_t->$_ (1) for qw/add_drop_table no_comments quote_identifiers/;
my $mid_schema = $parser_t->translate (
- data => $base_sql,
+ data => $base_out,
parser => $args->{engine},
parser_args => $args->{parser_args},
);
isa_ok ($mid_schema, 'SQL::Translator::Schema', "First $args->{name} parser pass produced a schema:")
- or diag (_gen_diag ( $parser_t->error, $base_sql ) );
+ or do {
+ diag (_gen_diag ( $parser_t->error, $base_out ) );
+ my $i;
+ note join ("\n" . ( '=' x 76) . "\n",
+ 'Unparseable DDL:',
+ (join ("\n", map { ++$i . ":\t$_" } split /\n/, $base_out) ),
+ ''
+ );
+ return;
+ };
# schemas should be comparable at least as far as table/field numbers go
is_deeply (
_get_table_info ($mid_schema->get_tables),
_get_table_info ($base_schema->get_tables),
"Schema tables generally match afer $args->{name} parser trip",
- );
+ ) or (diag(explain _get_table_info($mid_schema->get_tables)), return);
# and produce sql once again
# producer_args => $args->{producer_args},
# );
- my $rt_sql = $parser_t->translate (
+ my $rt_out = $parser_t->translate (
data => $mid_schema,
producer => $args->{engine},
producer_args => $args->{producer_args},
);
like (
- $rt_sql,
- qr/^\s*CREATE TABLE/m, #assume there is at least one create table statement
+ $rt_out,
+ $string_re->{$args->{engine}} || $string_re->{SQL},
"Received some meaningful output from the second $args->{name} production",
- ) or diag ( _gen_diag ( $parser_t->error ) );
+ ) or do {
+ diag ( _gen_diag ( $parser_t->error ) );
+ return;
+ };
# the two sql strings should be identical
my $msg = "$args->{name} SQL roundtrip successful - SQL statements match";
$ENV{SQLTTEST_RT_DEBUG}
- ? is_deeply (
- [ split /\n/, $rt_sql ],
- [ split /\n/, $base_sql ],
- $msg,
- )
- : ok ($rt_sql eq $base_sql, $msg)
+ ? eq_or_diff ($rt_out, $base_out, $msg)
+ : ok ($rt_out eq $base_out, $msg)
;
}
return \@info;
}
-# takes an error string and an optional SQL block
+# takes an error string and an optional output block
# returns the string conctenated with a line-numbered block for
# easier reading
sub _gen_diag {
- my ($err, $sql) = @_;
+ my ($err, $out) = @_;
return 'Unknown error' unless $err;
- if ($sql and $ENV{SQLTTEST_RT_DEBUG}) {
- my @sql_lines;
- for (split /\n/, $sql) {
- push @sql_lines, sprintf ('%03d: %s',
- scalar @sql_lines + 1,
+ if ($out and $ENV{SQLTTEST_RT_DEBUG}) {
+ my @lines;
+ for (split /\n/, $out) {
+ push @lines, sprintf ('%03d: %s',
+ scalar @lines + 1,
$_,
);
}
- return "$err\n\n" . join ("\n", @sql_lines);
+ return "$err\n\n" . join ("\n", @lines);
}
return $err;
projects / dbsrgits/SQL-Translator.git / blobdiff