X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F22xml-xmi-parser-visibility.t;h=acad644022956c393860449245b88ede4cba727a;hb=8c12c4066e7b70bfa3aee7185f831a30d2bf9025;hp=2f8b39d97ff784dba5f5296d3101354856f676a6;hpb=215c6c52ec63d0ada504254c49fef379f18e60a7;p=dbsrgits%2FSQL-Translator.git diff --git a/t/22xml-xmi-parser-visibility.t b/t/22xml-xmi-parser-visibility.t index 2f8b39d..acad644 100644 --- a/t/22xml-xmi-parser-visibility.t +++ b/t/22xml-xmi-parser-visibility.t @@ -5,100 +5,29 @@ # `make test'. After `make install' it should work as `perl test.pl' # -# basic.t -# ------- -# Tests that; +# Tests the visibility arg. # use strict; -use Test::More; -use Test::Exception; - -use strict; +use FindBin qw/$Bin/; use Data::Dumper; + +# run test with -d for debug my %opt; BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } use constant DEBUG => (exists $opt{d} ? 1 : 0); -use FindBin qw/$Bin/; - -# Usefull test subs for the schema objs -#============================================================================= - -my %ATTRIBUTES; -$ATTRIBUTES{field} = [qw/ -name -data_type -default_value -size -is_primary_key -is_unique -is_nullable -is_foreign_key -is_auto_increment -/]; - -sub test_field { - my ($fld,$test) = @_; - die "test_field needs a least a name!" unless $test->{name}; - my $name = $test->{name}; - - foreach my $attr ( @{$ATTRIBUTES{field}} ) { - if ( exists $test->{$attr} ) { - my $ans = $test->{$attr}; - if ( $attr =~ m/^is_/ ) { - if ($ans) { ok $fld->$attr, " $name - $attr true"; } - else { ok !$fld->$attr, " $name - $attr false"; } - } - else { - is $fld->$attr, $ans, " $name - $attr = '" - .(defined $ans ? $ans : "NULL" )."'"; - } - } - else { - ok !$fld->$attr, "$name - $attr not set"; - } - } -} - -sub test_table { - my $tbl = shift; - my %arg = @_; - my $name = $arg{name} || die "Need a table name to test."; - my @fldnames = map { $_->{name} } @{$arg{fields}}; - is_deeply( [ map {$_->name} $tbl->get_fields ], - [ map {$_->{name}} @{$arg{fields}} ], - "Table $name\'s fields" ); - foreach ( @{$arg{fields}} ) { - my $name = $_->{name} || die "Need a field name to test."; - test_field( $tbl->get_field($name), $_ ); - } -} +use Test::More; +use Test::Exception; +use SQL::Translator; +use SQL::Translator::Schema::Constants; -# Testing 1,2,3,.. -#============================================================================= plan tests => 8; -use SQL::Translator; -use SQL::Translator::Schema::Constants; - my $testschema = "$Bin/data/xmi/Foo.poseidon2.xmi"; die "Can't find test schema $testschema" unless -e $testschema; -my %base_translator_args = ( - filename => $testschema, - from => 'XML-XMI', - to => 'MySQL', - debug => DEBUG, - show_warnings => 1, - add_drop_table => 1, -); - -# -# Visibility tests -# -# Classes my @testd = ( "" => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/], [qw/fooid name protectedname privatename/], @@ -117,20 +46,19 @@ my @testd = ( to => 'MySQL', debug => DEBUG, show_warnings => 1, - add_drop_table => 1, parser_args => { visibility => $vis, }, ); my $sql = $obj->translate; + print $sql if DEBUG; my $scma = $obj->schema; - my @tblnames = map {$_->name} $scma->get_tables; + # Tables from classes + my @tblnames = map {$_->name} $scma->get_tables; is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'"); + # Fields from attributes my @fldnames = map {$_->name} $scma->get_table("Foo")->get_fields; is_deeply( \@fldnames, $foofields, "Foo fields with visibility => '$vis'"); - - #print "Debug: translator", Dumper($obj) if DEBUG; - #print "Debug: schema", Dumper($obj->schema) if DEBUG; }