t/60roundtrip.t

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Test::More qw/no_plan/;
   6 use Test::Exception;
   7 use Test::SQL::Translator qw(maybe_plan);
   8 use FindBin qw/$Bin/;
   9
  10 use SQL::Translator;
  11
  12 ### Set $ENV{SQLTTEST_RT_DEBUG} = 1 for more output
  13
  14 # What tests to run - parser/producer name, and optional args
  15 my $plan = [
  16   {
  17     engine => 'SQLite',
  18     producer_args => {},
  19     parser_args => {},
  20   },
  21   {
  22     engine => 'MySQL',
  23     producer_args => {},
  24     parser_args => {},
  25   },
  26   {
  27     engine => 'MySQL',
  28     name => 'MySQL 5.0',
  29     producer_args => { mysql_version => 5 },
  30     parser_args => { mysql_parser_version => 5 },
  31   },
  32   {
  33     engine => 'MySQL',
  34     name => 'MySQL 5.1',
  35     producer_args => { mysql_version => '5.1' },
  36     parser_args => { mysql_parser_version => '5.1' },
  37   },
  38   {
  39     engine => 'PostgreSQL',
  40     producer_args => {},
  41     parser_args => {},
  42   },
  43   {
  44     engine => 'Oracle',
  45     producer_args => {},
  46     parser_args => {},
  47   },
  48   {
  49     engine => 'SQLServer',
  50     producer_args => {},
  51     parser_args => {},
  52   },
  53   {
  54     engine => 'Sybase',
  55     producer_args => {},
  56     parser_args => {},
  57   },
  58   {
  59     engine => 'DB2',
  60     producer_args => {},
  61     parser_args => {},
  62   },
  63
  64 # There is no Access producer
  65 #  {
  66 #    engine => 'Access',
  67 #    producer_args => {},
  68 #    parser_args => {},
  69 #  },
  70 ];
  71
  72
  73 # This data file has the right mix of table/view/procedure/trigger
  74 # definitions, and lists enough quirks to trip up most combos
  75 # I am not sure if augmenting it will break other tests - experiment
  76 my $base_file = "$Bin/data/xml/schema.xml";
  77
  78 my $base_t = SQL::Translator->new;
  79 $base_t->$_ (1) for qw/add_drop_table no_comments/;
  80
  81 my $base_schema = $base_t->translate (
  82   parser => 'XML',
  83   file => $base_file,
  84 ) or die $base_t->error;
  85
  86
  87 for my $args (@$plan) {
  88
  89   $args->{name} ||= $args->{engine};
  90
  91   lives_ok (
  92     sub { check_roundtrip ($args, $base_schema) },
  93     "Round trip for $args->{name} did not throw an exception",
  94   );
  95 }
  96
  97
  98 sub check_roundtrip {
  99   my ($args, $base_schema) = @_;
 100   my $base_t = $base_schema->translator;
 101
 102 # create some sql from the submitted schema
 103   my $base_sql = $base_t->translate (
 104     data => $base_schema,
 105     producer => $args->{engine},
 106     producer_args => $args->{producer_args},
 107   );
 108
 109   like (
 110     $base_sql,
 111     qr/^\s*CREATE TABLE/m,  #assume there is at least one create table statement
 112     "Received some meaningful output from the first $args->{name} production",
 113   ) or diag ( _gen_diag ($base_t->error) );
 114
 115 # parse the sql back
 116   my $parser_t = SQL::Translator->new;
 117   $parser_t->$_ (1) for qw/add_drop_table no_comments/;
 118   my $mid_schema = $parser_t->translate (
 119     data => $base_sql,
 120     parser => $args->{engine},
 121     parser_args => $args->{parser_args},
 122   );
 123
 124   isa_ok ($mid_schema, 'SQL::Translator::Schema', "First $args->{name} parser pass produced a schema:")
 125     or diag (_gen_diag ( $parser_t->error, $base_sql ) );
 126
 127 # schemas should be comparable at least as far as table/field numbers go
 128   is_deeply (
 129     _get_table_info ($mid_schema->get_tables),
 130     _get_table_info ($base_schema->get_tables),
 131     "Schema tables generally match afer $args->{name} parser trip",
 132   );
 133
 134 # and produce sql once again
 135
 136 # Producing a schema with a Translator different from the one the schema was generated
 137 # from does not work. This is arguably a bug, 61translator_agnostic.t works with that
 138 #  my $producer_t = SQL::Translator->new;
 139 #  $producer_t->$_ (1) for qw/add_drop_table no_comments/;
 140
 141 #  my $rt_sql = $producer_t->translate (
 142 #    data => $mid_schema,
 143 #    producer => $args->{engine},
 144 #    producer_args => $args->{producer_args},
 145 #  );
 146
 147   my $rt_sql = $parser_t->translate (
 148     data => $mid_schema,
 149     producer => $args->{engine},
 150     producer_args => $args->{producer_args},
 151   );
 152
 153   like (
 154     $rt_sql,
 155     qr/^\s*CREATE TABLE/m,  #assume there is at least one create table statement
 156     "Received some meaningful output from the second $args->{name} production",
 157   ) or diag ( _gen_diag ( $parser_t->error ) );
 158
 159 # the two sql strings should be identical
 160   my $msg = "$args->{name} SQL roundtrip successful - SQL statements match";
 161   $ENV{SQLTTEST_RT_DEBUG}
 162     ? is_deeply (
 163       [ split /\n/, $rt_sql ],
 164       [ split /\n/, $base_sql ],
 165       $msg,
 166     )
 167     : ok ($rt_sql eq $base_sql, $msg)
 168   ;
 169 }
 170
 171 sub _get_table_info {
 172   my @tables = @_;
 173
 174   my @info;
 175
 176   for my $t (@tables) {
 177     push @info, {
 178       name => $t->name,
 179       fields => [
 180         map { $_->name } ($t->get_fields),
 181       ],
 182     };
 183   }
 184
 185   return \@info;
 186 }
 187
 188 # takes an error string and an optional SQL block
 189 # returns the string conctenated with a line-numbered block for
 190 # easier reading
 191 sub _gen_diag {
 192   my ($err, $sql) = @_;
 193
 194   return 'Unknown error' unless $err;
 195
 196
 197   if ($sql and $ENV{SQLTTEST_RT_DEBUG}) {
 198     my @sql_lines;
 199     for (split /\n/, $sql) {
 200       push @sql_lines, sprintf ('%03d: %s',
 201         scalar @sql_lines + 1,
 202         $_,
 203       );
 204     }
 205
 206     return "$err\n\n" . join ("\n", @sql_lines);
 207   }
 208
 209   return $err;
 210 }