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'
19 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
20 use constant DEBUG => (exists $opt{d} ? 1 : 0);
21 local $SIG{__WARN__} = sub { diag "[warn] ", @_; };
25 # Usefull test subs for the schema objs
26 #=============================================================================
29 $ATTRIBUTES{field} = [qw/
44 die "test_field needs a least a name!" unless $test->{name};
45 my $name = $test->{name};
46 is $fld->name, $name, "$name - Name right";
48 foreach my $attr ( @{$ATTRIBUTES{field}} ) {
49 if ( exists $test->{$attr} ) {
50 my $ans = $test->{$attr};
51 if ( $attr =~ m/^is_/ ) {
52 if ($ans) { ok $fld->$attr, " $name - $attr true"; }
53 else { ok !$fld->$attr, " $name - $attr false"; }
56 is $fld->$attr, $ans, " $name - $attr = '"
57 .(defined $ans ? $ans : "NULL" )."'";
61 ok !$fld->$attr, "$name - $attr not set";
66 # TODO test_constraint, test_index
69 #=============================================================================
74 use SQL::Translator::Schema::Constants;
76 # Parse the test XML schema
78 $obj = SQL::Translator->new(
83 my $testschema = "$Bin/data/xml/schema-basic.xml";
84 die "Can't find test schema $testschema" unless -e $testschema;
85 my $sql = $obj->translate(
88 filename => $testschema,
91 #print "Debug:", Dumper($obj) if DEBUG;
93 # Test the schema objs generted from the XML
95 my $scma = $obj->schema;
96 my @tblnames = map {$_->name} $scma->get_tables;
97 is_deeply( \@tblnames, [qw/Basic/], "tables");
100 my $tbl = $scma->get_table("Basic");
101 is $tbl->order, 1, "Basic->order";
102 is_deeply( [map {$_->name} $tbl->get_fields], [qw/
103 id title description email explicitnulldef explicitemptystring emptytagdef
104 /] , "Table Basic's fields");
105 test_field($tbl->get_field("id"),{
109 default_value => undef,
113 is_auto_increment => 1,
115 test_field($tbl->get_field("title"),{
118 data_type => "varchar",
120 default_value => "hello",
123 test_field($tbl->get_field("description"),{
124 name => "description",
130 test_field($tbl->get_field("email"),{
133 data_type => "varchar",
136 default_value => undef,
139 test_field($tbl->get_field("explicitnulldef"),{
140 name => "explicitnulldef",
142 data_type => "varchar",
143 default_value => undef,
146 test_field($tbl->get_field("explicitemptystring"),{
147 name => "explicitemptystring",
149 data_type => "varchar",
153 test_field($tbl->get_field("emptytagdef"),{
154 name => "emptytagdef",
156 data_type => "varchar",
161 my @indices = $tbl->get_indices;
162 is scalar(@indices), 1, "Table basic has 1 index";
164 my @constraints = $tbl->get_constraints;
165 is scalar(@constraints), 2, "Table basic has 2 constraints";
166 my $con = shift @constraints;
167 is $con->table, $tbl, "Constaints table right";
168 is $con->name, "", "Constaints table right";
169 is $con->type, PRIMARY_KEY, "Constaint is primary key";
170 is_deeply [$con->fields], ["id"], "Constaint fields";
171 $con = shift @constraints;
172 is $con->table, $tbl, "Constaints table right";
173 is $con->type, UNIQUE, "Constaint UNIQUE";
174 is_deeply [$con->fields], ["email"], "Constaint fields";