# What tests to run - parser/producer name, and optional args
my $plan = [
{
+ engine => 'XML',
+ },
+ {
engine => 'SQLite',
producer_args => {},
parser_args => {},
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,
+ $args->{engine} eq 'XML' #assume there is at least one table
+ ? qr/<tables>\s*<table/m
+ : qr/^\s*CREATE TABLE/m
+ ,
"Received some meaningful output from the first $args->{name} production",
) or do {
diag ( _gen_diag ($base_t->error) );
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 ) );
return;
};
# 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,
+ $args->{engine} eq 'XML' #assume there is at least one table
+ ? qr/<tables>\s*<table/m
+ : qr/^\s*CREATE TABLE/m
+ ,
"Received some meaningful output from the second $args->{name} production",
) or do {
diag ( _gen_diag ( $parser_t->error ) );
my $msg = "$args->{name} SQL roundtrip successful - SQL statements match";
$ENV{SQLTTEST_RT_DEBUG}
? is_deeply (
- [ split /\n/, $rt_sql ],
- [ split /\n/, $base_sql ],
+ [ split /\n/, $rt_out ],
+ [ split /\n/, $base_out ],
$msg,
)
- : ok ($rt_sql eq $base_sql, $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;