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'
20 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
21 use constant DEBUG => (exists $opt{d} ? 1 : 0);
22 local $SIG{__WARN__} = sub { diag "[warn] ", @_; };
26 # Usefull test subs for the schema objs
27 #=============================================================================
30 $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;
77 "$Bin/data/xml/schema-basic.xml",
78 "$Bin/data/xml/schema-basic-attribs.xml"
84 my $testschema = shift;
85 # Parse the test XML schema
87 $obj = SQL::Translator->new(
92 die "Can't find test schema $testschema" unless -e $testschema;
93 my $sql = $obj->translate(
94 from => 'XML-SQLFairy',
96 filename => $testschema,
99 #print "Debug:", Dumper($obj) if DEBUG;
101 # Test the schema objs generted from the XML
103 my $scma = $obj->schema;
104 my @tblnames = map {$_->name} $scma->get_tables;
105 is_deeply( \@tblnames, [qw/Basic/], "tables");
108 my $tbl = $scma->get_table("Basic");
109 is_deeply( [map {$_->name} $tbl->get_fields], [qw/
110 id title description email explicitnulldef explicitemptystring emptytagdef
111 /] , "Table Basic's fields");
112 test_field($tbl->get_field("id"),{
115 default_value => undef,
119 is_auto_increment => 1,
121 test_field($tbl->get_field("title"),{
123 data_type => "varchar",
125 default_value => "hello",
128 test_field($tbl->get_field("description"),{
129 name => "description",
134 test_field($tbl->get_field("email"),{
136 data_type => "varchar",
139 default_value => undef,
142 test_field($tbl->get_field("explicitnulldef"),{
143 name => "explicitnulldef",
144 data_type => "varchar",
145 default_value => undef,
148 test_field($tbl->get_field("explicitemptystring"),{
149 name => "explicitemptystring",
150 data_type => "varchar",
154 test_field($tbl->get_field("emptytagdef"),{
155 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";