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 qw/no_plan/;
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 ( defined(my $ans = $test->{$attr}) ) {
50 if ( $attr =~ m/^is_/ ) {
51 ok $fld->$attr, " $name - $attr true";
54 is $fld->$attr, $ans, " $name - $attr = '$ans'";
58 ok !$fld->$attr, "$name - $attr not set";
63 # TODO test_constraint, test_index
66 #=============================================================================
69 use SQL::Translator::Schema::Constants;
71 # Parse the test XML schema
73 $obj = SQL::Translator->new(
78 my $testschema = "$Bin/data/xml/schema-basic.xml";
79 die "Can't find test schema $testschema" unless -e $testschema;
80 my $sql = $obj->translate(
83 filename => $testschema,
86 #print "Debug:", Dumper($obj) if DEBUG;
88 # Test the schema objs generted from the XML
90 my $scma = $obj->schema;
91 my @tblnames = map {$_->name} $scma->get_tables;
92 is_deeply( \@tblnames, [qw/Basic/], "tables");
95 my $tbl = $scma->get_table("Basic");
96 is $tbl->order, 1, "Basic->order";
97 is_deeply( [map {$_->name} $tbl->get_fields], [qw/id title description email/]
98 , "Table Basic's fields");
99 test_field($tbl->get_field("id"),{
105 is_auto_increment => 1,
107 test_field($tbl->get_field("title"),{
110 data_type => "varchar",
111 default_value => "hello",
114 test_field($tbl->get_field("description"),{
115 name => "description",
120 test_field($tbl->get_field("email"),{
123 data_type => "varchar",
128 my @indices = $tbl->get_indices;
129 is scalar(@indices), 1, "Table basic has 1 index";
131 my @constraints = $tbl->get_constraints;
132 is scalar(@constraints), 2, "Table basic has 2 constraints";
133 my $con = shift @constraints;
134 is $con->table, $tbl, "Constaints table right";
135 is $con->name, "", "Constaints table right";
136 is $con->type, PRIMARY_KEY, "Constaint is primary key";
137 is_deeply [$con->fields], ["id"], "Constaint fields";
138 $con = shift @constraints;
139 is $con->table, $tbl, "Constaints table right";
140 is $con->type, UNIQUE, "Constaint UNIQUE";
141 is_deeply [$con->fields], ["email"], "Constaint fields";