4 # Before `make install' is performed this script should be runnable with
5 # `make test'. After `make install' it should work as `perl test.pl'
11 # run with -d for debug
13 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
14 use constant DEBUG => (exists $opt{d} ? 1 : 0);
18 use Test::SQL::Translator qw(maybe_plan);
20 use SQL::Translator::Schema::Constants;
24 'SQL::Translator::Parser::XML::XMI::Rational',
25 'SQL::Translator::Producer::MySQL');
28 # Usefull test subs for the schema objs
29 #=============================================================================
34 is( $f1->name, $test->{name}, " Field name '$test->{name}'" );
36 is( $f1->data_type, $test->{data_type}, " Type is '$test->{data_type}'" )
37 if exists $test->{data_type};
39 is( $f1->size, $test->{size}, " Size is '$test->{size}'" )
40 if exists $test->{size};
42 is( $f1->default_value, $test->{default_value},
43 " Default value is ".(defined($test->{default_value}) ? "'$test->{default_value}'" : "UNDEF" ) )
44 if exists $test->{default_value};
46 is( $f1->is_nullable, $test->{is_nullable},
47 " ".($test->{is_nullable} ? 'can' : 'cannot').' be null' )
48 if exists $test->{is_nullable};
50 is( $f1->is_unique, $test->{is_unique},
51 " ".($test->{is_unique} ? 'can' : 'cannot').' be unique' )
52 if exists $test->{is_unique};
54 is( $f1->is_primary_key, $test->{is_primary_key},
55 " is ".($test->{is_primary_key} ? '' : 'not').' a primary_key' )
56 if exists $test->{is_primary_key};
58 is( $f1->is_foreign_key, $test->{is_foreign_key},
59 " is ".($test->{is_foreign_key} ? '' : 'not').' a foreign_key' )
60 if exists $test->{is_foreign_key};
62 is( $f1->is_auto_increment, $test->{is_auto_increment},
63 " is ".($test->{is_auto_increment} ? '' : 'not').' an auto_increment' )
64 if exists $test->{is_auto_increment};
69 #$test->{name} ||= "<anon>";
71 if ( exists $test->{name} ) {
72 is( $con->name, $test->{name}, " Constraint '$test->{name}'" );
75 ok( $con, " Constraint" );
78 is( $con->type, $test->{type}, " type is '$test->{type}'" )
79 if exists $test->{type};
81 is( $con->table->name, $test->{table}, " table is '$test->{table}'" )
82 if exists $test->{table};
84 is( join(",",$con->fields), $test->{fields},
85 " fields is '$test->{fields}'" )
86 if exists $test->{fields};
88 is( $con->reference_table, $test->{reference_table},
89 " reference_table is '$test->{reference_table}'" )
90 if exists $test->{reference_table};
92 is( join(",",$con->reference_fields), $test->{reference_fields},
93 " reference_fields is '$test->{reference_fields}'" )
94 if exists $test->{reference_fields};
96 is( $con->match_type, $test->{match_type},
97 " match_type is '$test->{match_type}'" )
98 if exists $test->{match_type};
100 is( $con->on_delete_do, $test->{on_delete_do},
101 " on_delete_do is '$test->{on_delete_do}'" )
102 if exists $test->{on_delete_do};
104 is( $con->on_update_do, $test->{on_update_do},
105 " on_update_do is '$test->{on_update_do}'" )
106 if exists $test->{on_update_do};
112 $arg{constraints} ||= [];
113 my $name = $arg{name} || die "Need a table name to test.";
115 my @fldnames = map { $_->{name} } @{$arg{fields}};
116 is_deeply( [ map {$_->name} $tbl->get_fields ],
117 [ map {$_->{name}} @{$arg{fields}} ],
118 "Table $name\'s fields" );
119 foreach ( @{$arg{fields}} ) {
120 my $name = $_->{name} || die "Need a field name to test.";
121 test_field( $tbl->get_field($name), $_ );
124 if ( my @tcons = @{$arg{constraints}} ) {
125 my @cons = $tbl->get_constraints;
126 is(scalar(@cons), scalar(@tcons),
127 "Table $name has ".scalar(@tcons)." Constraints");
129 my $ans = { table => $tbl->name, %{shift @tcons}};
130 constraint_ok( $_, $ans );
136 #=============================================================================
138 my $testschema = "$Bin/data/xmi/OrderDB.rationalprofile.poseidon2.xmi";
139 die "Can't find test schema $testschema" unless -e $testschema;
142 $obj = SQL::Translator->new(
143 filename => $testschema,
144 from => 'XML-XMI-Rational',
150 my $sql = $obj->translate;
156 my $scma = $obj->schema;
157 is( $scma->is_valid, 1, 'Schema is valid' );
158 my @tblnames = map {$_->name} $scma->get_tables;
159 is(scalar(@{$scma->get_tables}), scalar(@tblnames), "Right number of tables");
160 is_deeply( \@tblnames, [qw/Order OrderLine Customer/]
163 test_table( $scma->get_table("Customer"),
167 name => "customerID",
170 default_value => undef,
176 data_type => "VARCHAR",
178 default_value => undef,
184 data_type => "VARCHAR",
186 default_value => undef,
193 type => "PRIMARY KEY",
194 fields => "customerID",
197 name => "UniqueEmail",
204 test_table( $scma->get_table("Order"),
211 default_value => undef,
216 name => "customerID",
219 default_value => undef,
227 default_value => undef,
234 type => "PRIMARY KEY",
238 type => "FOREIGN KEY",
239 fields => "customerID",
240 reference_table => "Customer",
241 reference_fields => "customerID",
247 # name => "idxOrderDate",
249 # fields => "orderDate",
255 test_table( $scma->get_table("OrderLine"),
259 name => "lineNumber",
270 default_value => undef,
286 type => "PRIMARY KEY",
287 fields => "lineNumber,orderID",
290 type => "FOREIGN KEY",
292 reference_table => "Order",
293 reference_fields => "orderID",