From: Mark Addison <grommit@users.sourceforge.net>
Date: Wed, 1 Oct 2003 21:12:00 +0000 (+0000)
Subject: Moved visibility test to its own .t
X-Git-Tag: v0.04~158
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=215c6c52ec63d0ada504254c49fef379f18e60a7;p=dbsrgits%2FSQL-Translator.git

Moved visibility test to its own .t
---

diff --git a/t/21xml-xmi-parser.t b/t/21xml-xmi-parser.t
index d5f6429..773d8b9 100644
--- a/t/21xml-xmi-parser.t
+++ b/t/21xml-xmi-parser.t
@@ -19,7 +19,6 @@ use Data::Dumper;
 my %opt;
 BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
 use constant DEBUG => (exists $opt{d} ? 1 : 0);
-local $SIG{__WARN__} = sub { diag "[warn] ", @_; };
 
 use FindBin qw/$Bin/;
 
@@ -79,7 +78,7 @@ sub test_table {
 # Testing 1,2,3,..
 #=============================================================================
 
-plan tests => 111;
+plan tests => 103;
 
 use SQL::Translator;
 use SQL::Translator::Schema::Constants;
@@ -98,8 +97,6 @@ my %base_translator_args = (
 #
 # Basic tests
 #
-{
-
 my $obj;
 $obj = SQL::Translator->new(
     filename => $testschema,
@@ -220,78 +217,3 @@ test_table( $scma->get_table("Track"),
     },
     ],
 );
-
-} # end basic tests
-
-#
-# Visibility tests
-#
-{
-
-# Classes
-my @testd = (
-    ""          => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
-                   [qw/fooid name protectedname privatename/],
-    "public"    => [qw/Foo Recording CD Track/],
-                   [qw/fooid name /],
-    "protected" => [qw/Foo Recording CD Track ProtectedFoo/],
-                   [qw/fooid name protectedname/],
-    "private"   => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
-                   [qw/fooid name protectedname privatename/],
-);
-    while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) {
-    my $obj;
-    $obj = SQL::Translator->new(
-        filename => $testschema,
-        from     => 'XML-XMI',
-        to       => 'MySQL',
-        debug          => DEBUG,
-        show_warnings  => 1,
-        add_drop_table => 1,
-        parser_args => {
-            visibility => $vis,
-        },
-    );
-    my $sql = $obj->translate;
-    my $scma = $obj->schema;
-
-    my @tblnames = map {$_->name} $scma->get_tables;
-    is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'");
-
-    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;
-}
-
-# # Classes
-# %testd = (
-#     ""          => [qw/fooid name protectedname privatename/],
-#     "public"    => [qw/fooid name /],
-#     "protected" => [qw/fooid name protectedname/],
-#     "private"   => [qw/fooid name protectedname privatename/],
-# );
-#     while ( my ($vis,$ans) = each %testd ) {
-#     my $obj;
-#     $obj = SQL::Translator->new(
-#         filename => $testschema,
-#         from     => 'XML-XMI',
-#         to       => 'MySQL',
-#         debug          => DEBUG,
-#         show_warnings  => 1,
-#         add_drop_table => 1,
-#         parser_args => {
-#             visibility => $vis,
-#         },
-#     );
-#     my $sql = $obj->translate;
-#     my $scma = $obj->schema;
-#     my @names = map {$_->name} $scma->get_table("Foo")->get_fields;
-#     is_deeply( \@names, $ans, "Foo fields with visibility => '$vis'");
-#     
-#     #print "Debug: translator", Dumper($obj) if DEBUG;
-#     #print "Debug: schema", Dumper($obj->schema) if DEBUG;
-# }
-# 
-} # end visibility tests
diff --git a/t/22xml-xmi-parser-visibility.t b/t/22xml-xmi-parser-visibility.t
new file mode 100644
index 0000000..2f8b39d
--- /dev/null
+++ b/t/22xml-xmi-parser-visibility.t
@@ -0,0 +1,136 @@
+#!/usr/bin/perl -w 
+# vim:filetype=perl
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#
+# basic.t
+# -------
+# Tests that;
+#
+
+use strict;
+use Test::More;
+use Test::Exception;
+
+use strict;
+use Data::Dumper;
+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), $_ );
+    }
+}
+
+# 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/],
+    "public"    => [qw/Foo Recording CD Track/],
+                   [qw/fooid name /],
+    "protected" => [qw/Foo Recording CD Track ProtectedFoo/],
+                   [qw/fooid name protectedname/],
+    "private"   => [qw/Foo PrivateFoo Recording CD Track ProtectedFoo/],
+                   [qw/fooid name protectedname privatename/],
+);
+    while ( my ($vis,$tables,$foofields) = splice @testd,0,3 ) {
+    my $obj;
+    $obj = SQL::Translator->new(
+        filename => $testschema,
+        from     => 'XML-XMI',
+        to       => 'MySQL',
+        debug          => DEBUG,
+        show_warnings  => 1,
+        add_drop_table => 1,
+        parser_args => {
+            visibility => $vis,
+        },
+    );
+    my $sql = $obj->translate;
+    my $scma = $obj->schema;
+
+    my @tblnames = map {$_->name} $scma->get_tables;
+    is_deeply( \@tblnames, $tables, "Tables with visibility => '$vis'");
+
+    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;
+}