X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F60roundtrip.t;h=f04417f3f3718196a64bf62174d145ace7ef9006;hb=aa068030f5b8038d5f5653b70cfcf478bf52583e;hp=d667b926c6eb7a789b8ce55b61b65846b1b86c43;hpb=e2fb9ad304efa82aeccc2c266f3eb165f2f51950;p=dbsrgits%2FSQL-Translator.git

diff --git a/t/60roundtrip.t b/t/60roundtrip.t
index d667b92..f04417f 100644
--- a/t/60roundtrip.t
+++ b/t/60roundtrip.t
@@ -8,6 +8,8 @@ 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
 
@@ -15,7 +17,14 @@ use SQL::Translator;
 my $plan = [
   {
     engine => 'XML',
+    req => 'XML::LibXML 1.69',
+    no_grammar => 1,
+  },
+  {
+    engine => 'YAML',
+    no_grammar => 1,
   },
+
   {
     engine => 'SQLite',
     producer_args => {},
@@ -48,26 +57,25 @@ my $plan = [
     producer_args => {},
     parser_args => {},
   },
-#  {
-#    engine => 'Oracle',
-#    producer_args => {},
-#    parser_args => {},
-#  },
-#  {
-#    engine => 'Sybase',
-#    producer_args => {},
-#    parser_args => {},
-#  },
-#  {
-#    engine => 'DB2',
-#    producer_args => {},
-#    parser_args => {},
-#  },
 
-# YAML parsing/producing cycles result in some weird self referencing structure
-#  {
-#    engine => 'YAML',
-#  },
+  {
+    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
 #  {
@@ -80,17 +88,18 @@ 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/<tables>\s*<table/,
@@ -99,13 +108,43 @@ my $string_re = {
 };
 
 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",
+      );
+    }
+  }
 }
 
 
@@ -141,6 +180,12 @@ sub check_roundtrip {
   isa_ok ($mid_schema, 'SQL::Translator::Schema', "First $args->{name} parser pass produced a schema:")
     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;
     };
 
@@ -181,9 +226,9 @@ sub check_roundtrip {
 
 # the two sql strings should be identical
   my $msg = "$args->{name} SQL roundtrip successful - SQL statements match";
-  $ENV{SQLTTEST_RT_DEBUG}     #stringify below because IO::Scalar does not behave nice
-    ? eq_or_diff ("$rt_out", "$base_out", $msg)
-    : ok ("$rt_out" eq "$base_out", $msg)
+  $ENV{SQLTTEST_RT_DEBUG}
+    ? eq_or_diff ($rt_out, $base_out, $msg)
+    : ok ($rt_out eq $base_out, $msg)
   ;
 }