From: Peter Rabbitson Date: Tue, 28 Apr 2009 07:34:49 +0000 (+0000) Subject: Somewhat working global roundtrip test X-Git-Tag: v0.11008~163^2~26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6c9e9546e58cb9383ec0c9d214107d336404796d;p=dbsrgits%2FSQL-Translator.git Somewhat working global roundtrip test --- diff --git a/t/27sqlite-roundtrip.t b/t/27sqlite-roundtrip.t deleted file mode 100644 index 9e871d0..0000000 --- a/t/27sqlite-roundtrip.t +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl - -use warnings; -use strict; -use Test::More; -use Test::SQL::Translator qw(maybe_plan); -use FindBin qw/$Bin/; - -use SQL::Translator; -use SQL::Translator::Schema::Constants; - -BEGIN { - maybe_plan(7, - 'SQL::Translator::Parser::SQLite', - 'SQL::Translator::Producer::SQLite', - ); -} - -my $file = "$Bin/data/sqlite/create.sql"; - -{ - #local $/; - #open my $fh, "<$file" or die "Can't read file '$file': $!\n"; - #my $data = <$fh>; - - my $t = SQL::Translator->new; - - my $schema1 = $t->translate ( - parser => 'SQLite', - file => $file, - debug => 1 - ) or die $t->error; - isa_ok ($schema1, 'SQL::Translator::Schema', 'First parser pass produced a schema'); - - - my $data2 = $t->translate ( - data => $schema1, - producer => 'SQLite', - ) or die $t->error; - like ($data2, qr/BEGIN.+COMMIT/is, 'Received some meaningful output from the producer'); - - # get a new translator - $t = SQL::Translator->new; - - my $schema2 = $t->translate ( - parser => 'SQLite', - data => \$data2, - ) or die $t->error; - isa_ok ($schema2, 'SQL::Translator::Schema', 'Second parser pass produced a schema'); - - my @t1 = $schema1->get_tables; - my @t2 = $schema2->get_tables; - - my @v1 = $schema1->get_views; - my @v2 = $schema2->get_views; - - my @g1 = $schema1->get_triggers; - my @g2 = $schema2->get_triggers; - - is (@t2, @t1, 'Equal amount of tables'); - - is_deeply ( - [ map { $_->name } (@t1) ], - [ map { $_->name } (@t2) ], - 'Table names match', - ); - - is (@v2, @v1, 'Equal amount of views'); - - is (@g2, @g1, 'Equal amount of triggers'); -} diff --git a/t/60roundtrip.t b/t/60roundtrip.t new file mode 100644 index 0000000..0a203f0 --- /dev/null +++ b/t/60roundtrip.t @@ -0,0 +1,183 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use Test::More qw/no_plan/; +use Test::Exception; +use Test::SQL::Translator qw(maybe_plan); +use FindBin qw/$Bin/; + +use SQL::Translator; + +### Set $ENV{SQLTTEST_RT_DEBUG} = 1 for more output + +# What tests to run - parser/producer name, and optional args +my $plan = [ + { + engine => 'SQLite', + producer_args => {}, + parser_args => {}, + }, + { + engine => 'MySQL', + producer_args => {}, + parser_args => {}, + }, + { + engine => 'MySQL', + name => 'MySQL 5.0', + producer_args => { mysql_version => 5 }, + parser_args => { mysql_parser_version => 5 }, + }, + { + engine => 'MySQL', + name => 'MySQL 5.1', + producer_args => { mysql_version => '5.1' }, + parser_args => { mysql_parser_version => '5.1' }, + }, + { + engine => 'PostgreSQL', + producer_args => {}, + parser_args => {}, + }, +]; + + +# 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_t = SQL::Translator->new; +$base_t->$_ (1) for qw/validate add_drop_table no_comments/; + +my $base_schema = $base_t->translate ( + parser => 'XML', + file => $base_file, +) or die $base_t->error; + + +for my $args (@$plan) { + + $args->{name} ||= $args->{engine}; + + lives_ok ( + sub { check_roundtrip ($args, $base_schema) }, + "Round trip for $args->{name} did not throw an exception", + ); +} + + +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 ( + 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 + "Received some meaningful output from the first $args->{name} production", + ) or diag ( _gen_diag ($base_t->error) ); + +# parse the sql back + my $parser_t = SQL::Translator->new; + $parser_t->$_ (1) for qw/validate add_drop_table no_comments/; + my $mid_schema = $parser_t->translate ( + data => $base_sql, + 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 ) ); + +# 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", + ); + +# and produce sql once again + +# Producing a schema with a Translator different from the one the schema was generated +# from does not work. This is arguably a bug, 61translator_agnostic.t works with that +# my $producer_t = SQL::Translator->new; +# $producer_t->$_ (1) for qw/validate add_drop_table no_comments/; + +# my $rt_sql = $producer_t->translate ( +# data => $mid_schema, +# producer => $args->{engine}, +# producer_args => $args->{producer_args}, +# ); + + my $rt_sql = $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 + "Received some meaningful output from the second $args->{name} production", + ) or diag ( _gen_diag ( $parser_t->error ) ); + +# 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) + ; +} + +sub _get_table_info { + my @tables = @_; + + my @info; + + for my $t (@tables) { + push @info, { + name => $t->name, + fields => [ + map { $_->name } ($t->get_fields), + ], + }; + } + + return \@info; +} + +# takes an error string and an optional SQL block +# returns the string conctenated with a line-numbered block for +# easier reading +sub _gen_diag { + my ($err, $sql) = @_; + + 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, + $_, + ); + } + + return "$err\n\n" . join ("\n", @sql_lines); + } + + return $err; +}