X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F60roundtrip.t;h=f04417f3f3718196a64bf62174d145ace7ef9006;hb=9f03b4c2b4bd45fee14200f37760d96ccde24c6c;hp=4cfc53a566c5539b74ab4ad1fa5d7e48de356e58;hpb=4c549812488b91265b0440322cc6b5682080d2d3;p=dbsrgits%2FSQL-Translator.git diff --git a/t/60roundtrip.t b/t/60roundtrip.t index 4cfc53a..f04417f 100644 --- a/t/60roundtrip.t +++ b/t/60roundtrip.t @@ -4,15 +4,28 @@ use warnings; use strict; use Test::More qw/no_plan/; use Test::Exception; +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 => {}, @@ -40,24 +53,28 @@ my $plan = [ 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 @@ -71,26 +88,63 @@ my $plan = [ # 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/; 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/\s* 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", + ); + } + } } @@ -98,16 +152,16 @@ sub check_roundtrip { 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 do { diag ( _gen_diag ($base_t->error) ); @@ -118,14 +172,20 @@ sub check_roundtrip { my $parser_t = SQL::Translator->new; $parser_t->$_ (1) for qw/add_drop_table no_comments/; 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 do { - diag (_gen_diag ( $parser_t->error, $base_sql ) ); + 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; }; @@ -149,15 +209,15 @@ sub check_roundtrip { # 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 do { diag ( _gen_diag ( $parser_t->error ) ); @@ -167,12 +227,8 @@ sub check_roundtrip { # 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) ; } @@ -193,25 +249,25 @@ sub _get_table_info { 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;