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'
13 use Test::More tests => 78;
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 #=============================================================================
72 use SQL::Translator::Schema::Constants;
74 # Parse the test XML schema
76 $obj = SQL::Translator->new(
81 my $testschema = "$Bin/data/xml/schema-basic.xml";
82 die "Can't find test schema $testschema" unless -e $testschema;
83 my $sql = $obj->translate(
86 filename => $testschema,
89 #print "Debug:", Dumper($obj) if DEBUG;
91 # Test the schema objs generted from the XML
93 my $scma = $obj->schema;
94 my @tblnames = map {$_->name} $scma->get_tables;
95 is_deeply( \@tblnames, [qw/Basic/], "tables");
98 my $tbl = $scma->get_table("Basic");
99 is $tbl->order, 1, "Basic->order";
100 is_deeply( [map {$_->name} $tbl->get_fields],
101 [qw/id title description email explicitnulldef explicitemptystring/] ,
102 "Table Basic's fields");
103 test_field($tbl->get_field("id"),{
107 default_value => undef,
111 is_auto_increment => 1,
113 test_field($tbl->get_field("title"),{
116 data_type => "varchar",
118 default_value => "hello",
121 test_field($tbl->get_field("description"),{
122 name => "description",
128 test_field($tbl->get_field("email"),{
131 data_type => "varchar",
134 default_value => undef,
137 test_field($tbl->get_field("explicitnulldef"),{
138 name => "explicitnulldef",
140 data_type => "varchar",
141 default_value => undef,
144 test_field($tbl->get_field("explicitemptystring"),{
145 name => "explicitemptystring",
147 data_type => "varchar",
152 my @indices = $tbl->get_indices;
153 is scalar(@indices), 1, "Table basic has 1 index";
155 my @constraints = $tbl->get_constraints;
156 is scalar(@constraints), 2, "Table basic has 2 constraints";
157 my $con = shift @constraints;
158 is $con->table, $tbl, "Constaints table right";
159 is $con->name, "", "Constaints table right";
160 is $con->type, PRIMARY_KEY, "Constaint is primary key";
161 is_deeply [$con->fields], ["id"], "Constaint fields";
162 $con = shift @constraints;
163 is $con->table, $tbl, "Constaints table right";
164 is $con->type, UNIQUE, "Constaint UNIQUE";
165 is_deeply [$con->fields], ["email"], "Constaint fields";