Commit | Line | Data |
c957e92d |
1 | #!/usr/bin/perl -w |
2 | # vim:filetype=perl |
3 | |
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' |
6 | |
7 | # |
8 | # basic.t |
9 | # ------- |
10 | # Tests that; |
11 | # |
12 | |
b3530353 |
13 | use Test::More; |
c957e92d |
14 | use Test::Exception; |
15 | |
16 | use strict; |
17 | use Data::Dumper; |
18 | our %opt; |
19 | BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } |
20 | use constant DEBUG => (exists $opt{d} ? 1 : 0); |
21 | local $SIG{__WARN__} = sub { diag "[warn] ", @_; }; |
22 | |
23 | use FindBin qw/$Bin/; |
24 | |
25 | # Usefull test subs for the schema objs |
26 | #============================================================================= |
27 | |
28 | our %ATTRIBUTES; |
29 | $ATTRIBUTES{field} = [qw/ |
30 | name |
c957e92d |
31 | data_type |
32 | default_value |
33 | size |
34 | is_primary_key |
35 | is_unique |
36 | is_nullable |
37 | is_foreign_key |
38 | is_auto_increment |
39 | /]; |
40 | |
41 | sub test_field { |
5ff70f1a |
42 | my ($fld,$test) = @_; |
43 | die "test_field needs a least a name!" unless $test->{name}; |
44 | my $name = $test->{name}; |
45 | is $fld->name, $name, "$name - Name right"; |
46 | |
47 | foreach my $attr ( @{$ATTRIBUTES{field}} ) { |
48 | if ( exists $test->{$attr} ) { |
49 | my $ans = $test->{$attr}; |
50 | if ( $attr =~ m/^is_/ ) { |
51 | if ($ans) { ok $fld->$attr, " $name - $attr true"; } |
52 | else { ok !$fld->$attr, " $name - $attr false"; } |
53 | } |
54 | else { |
55 | is $fld->$attr, $ans, " $name - $attr = '" |
56 | .(defined $ans ? $ans : "NULL" )."'"; |
57 | } |
58 | } |
59 | else { |
60 | ok !$fld->$attr, "$name - $attr not set"; |
61 | } |
62 | } |
c957e92d |
63 | } |
64 | |
65 | # TODO test_constraint, test_index |
66 | |
67 | # Testing 1,2,3,4... |
68 | #============================================================================= |
69 | |
07a82527 |
70 | plan tests => 162; |
b3530353 |
71 | |
c957e92d |
72 | use SQL::Translator; |
73 | use SQL::Translator::Schema::Constants; |
74 | |
07a82527 |
75 | foreach ( |
76 | "$Bin/data/xml/schema-basic.xml", |
77 | "$Bin/data/xml/schema-basic-attribs.xml" |
78 | ) { |
79 | do_file($_); |
80 | } |
81 | |
82 | sub do_file { |
83 | my $testschema = shift; |
84 | # Parse the test XML schema |
85 | our $obj; |
86 | $obj = SQL::Translator->new( |
87 | debug => DEBUG, |
88 | show_warnings => 1, |
89 | add_drop_table => 1, |
90 | ); |
91 | die "Can't find test schema $testschema" unless -e $testschema; |
92 | my $sql = $obj->translate( |
93 | from => "SqlfXML", |
94 | to =>"MySQL", |
95 | filename => $testschema, |
96 | ); |
97 | print $sql if DEBUG; |
98 | #print "Debug:", Dumper($obj) if DEBUG; |
99 | |
100 | # Test the schema objs generted from the XML |
101 | # |
102 | my $scma = $obj->schema; |
103 | my @tblnames = map {$_->name} $scma->get_tables; |
104 | is_deeply( \@tblnames, [qw/Basic/], "tables"); |
105 | |
106 | # Basic |
107 | my $tbl = $scma->get_table("Basic"); |
108 | is_deeply( [map {$_->name} $tbl->get_fields], [qw/ |
109 | id title description email explicitnulldef explicitemptystring emptytagdef |
110 | /] , "Table Basic's fields"); |
111 | test_field($tbl->get_field("id"),{ |
112 | name => "id", |
113 | data_type => "int", |
114 | default_value => undef, |
115 | is_nullable => 0, |
116 | size => 10, |
117 | is_primary_key => 1, |
118 | is_auto_increment => 1, |
119 | }); |
120 | test_field($tbl->get_field("title"),{ |
121 | name => "title", |
122 | data_type => "varchar", |
123 | is_nullable => 0, |
124 | default_value => "hello", |
125 | size => 100, |
126 | }); |
127 | test_field($tbl->get_field("description"),{ |
128 | name => "description", |
129 | data_type => "text", |
130 | is_nullable => 1, |
131 | default_value => "", |
132 | }); |
133 | test_field($tbl->get_field("email"),{ |
134 | name => "email", |
135 | data_type => "varchar", |
136 | size => 255, |
137 | is_unique => 1, |
138 | default_value => undef, |
139 | is_nullable => 1, |
140 | }); |
141 | test_field($tbl->get_field("explicitnulldef"),{ |
142 | name => "explicitnulldef", |
143 | data_type => "varchar", |
144 | default_value => undef, |
145 | is_nullable => 1, |
146 | }); |
147 | test_field($tbl->get_field("explicitemptystring"),{ |
148 | name => "explicitemptystring", |
149 | data_type => "varchar", |
150 | default_value => "", |
151 | is_nullable => 1, |
152 | }); |
153 | test_field($tbl->get_field("emptytagdef"),{ |
154 | name => "emptytagdef", |
155 | data_type => "varchar", |
156 | default_value => "", |
157 | is_nullable => 1, |
158 | }); |
159 | |
160 | my @indices = $tbl->get_indices; |
161 | is scalar(@indices), 1, "Table basic has 1 index"; |
162 | |
163 | my @constraints = $tbl->get_constraints; |
164 | is scalar(@constraints), 2, "Table basic has 2 constraints"; |
165 | my $con = shift @constraints; |
166 | is $con->table, $tbl, "Constaints table right"; |
167 | is $con->name, "", "Constaints table right"; |
168 | is $con->type, PRIMARY_KEY, "Constaint is primary key"; |
169 | is_deeply [$con->fields], ["id"], "Constaint fields"; |
170 | $con = shift @constraints; |
171 | is $con->table, $tbl, "Constaints table right"; |
172 | is $con->type, UNIQUE, "Constaint UNIQUE"; |
173 | is_deeply [$con->fields], ["email"], "Constaint fields"; |
174 | } # /Test of schema |