From: Mark Addison Date: Sun, 29 Feb 2004 20:10:35 +0000 (+0000) Subject: Added schema_ok. Some tweaks to the test output. X-Git-Tag: v0.06~166 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a0eb602d9739dc11c857e43f4b087b5e8274f407;hp=1c375f480a1472ac584677277d2049e674bcbd1e;p=dbsrgits%2FSQL-Translator.git Added schema_ok. Some tweaks to the test output. --- diff --git a/lib/Test/SQL/Translator.pm b/lib/Test/SQL/Translator.pm index b2d67e9..3e8b08b 100644 --- a/lib/Test/SQL/Translator.pm +++ b/lib/Test/SQL/Translator.pm @@ -1,7 +1,7 @@ package Test::SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.1 2004-02-29 18:26:53 grommit Exp $ +# $Id: Translator.pm,v 1.2 2004-02-29 20:10:35 grommit Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 The SQLFairy Authors # @@ -34,8 +34,9 @@ use warnings; use base qw(Exporter); use vars qw($VERSION @EXPORT @EXPORT_OK); -$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; @EXPORT = qw( + schema_ok table_ok field_ok constraint_ok @@ -44,7 +45,6 @@ $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; trigger_ok procedure_ok ); -# TODO schema_ok use Test::More; use Test::Exception; @@ -93,6 +93,7 @@ $ATTRIBUTES{'view'} = { name => "", sql => "", fields => [], + is_valid => 1, }; $ATTRIBUTES{'trigger'} = { name => '', @@ -100,6 +101,7 @@ $ATTRIBUTES{'trigger'} = { database_event => undef, on_table => undef, action => undef, + is_valid => 1, }; $ATTRIBUTES{'procedure'} = { name => '', @@ -117,6 +119,16 @@ $ATTRIBUTES{table} = { fields => undef, constraints => undef, indices => undef, + is_valid => 1, +}; +$ATTRIBUTES{schema} = { + name => '', + database => '', + procedures => undef, # [] when set + tables => undef, # [] when set + triggers => undef, # [] when set + views => undef, # [] when set + is_valid => 1, }; @@ -148,13 +160,17 @@ sub field_ok { unless ($f1) { fail " Field '$test->{name}' doesn't exist!"; + # TODO Do a skip on the following tests. Currently the test counts wont + # match at the end. So at least it fails. return; } - is( $f1->name, $test->{name}, "${t_name}Field name '$test->{name}'" ); + my $full_name = $f1->table->name.".".$test->{name}; + + is( $f1->name, $test->{name}, "${t_name}Field '$full_name'" ); is( $f1->is_valid, $test->{is_valid}, - "$t_name is".($test->{is_valid} ? '' : 'not ').'valid' ); + "$t_name is ".($test->{is_valid} ? '' : 'not ').'valid' ); is( $f1->data_type, $test->{data_type}, "$t_name type is '$test->{data_type}'" ); @@ -315,41 +331,53 @@ sub table_ok { my %arg = %$test; my $tbl_name = $arg{name} || die "Need a table name to test."; - is( $obj->{name}, $arg{name}, "${t_name}Table name '$arg{name}'" ); + is( $obj->{name}, $arg{name}, "${t_name}Table '$arg{name}'" ); is_deeply( [$obj->options], $test->{options}, "$t_name options are '".join(",",@{$test->{options}})."'" ); # Fields if ( $arg{fields} ) { - my @fldnames = map { $_->{name} } @{$arg{fields}}; - is_deeply( [ map {$_->name} $obj->get_fields ], - [ map {$_->{name}} @{$arg{fields}} ], - "${t_name}Table $tbl_name fields match" ); + my @fldnames = map {$_->{name}} @{$arg{fields}}; + is_deeply( + [ map {$_->name} $obj->get_fields ], + [ @fldnames ], + "${t_name} field names are ".join(", ",@fldnames) + ); foreach ( @{$arg{fields}} ) { my $f_name = $_->{name} || die "Need a field name to test."; - field_ok( $obj->get_field($f_name), $_, $name ); + next unless my $fld = $obj->get_field($f_name); + field_ok( $fld, $_, $name ); } } else { is(scalar($obj->get_fields), undef, - "${t_name}Table $tbl_name has no fields."); + "${t_name} has no fields."); } - # Constraints and indices - my %bits = ( + # Constraints and Indices + _test_kids($obj, $test, $name, { constraint => "constraints", 'index' => "indices", - ); - while ( my($foo,$plural) = each %bits ) { - next unless defined $arg{$plural}; - if ( my @tfoo = @{$arg{$plural}} ) { + }); +} + +sub _test_kids { + my ($obj, $test, $name, $kids) = @_; + my $t_name = t_name($name); + my $obj_name = ref $obj; + ($obj_name) = $obj_name =~ m/^.*::(.*)$/; + + while ( my($foo,$plural) = each %$kids ) { + next unless defined $test->{$plural}; + if ( my @tfoo = @{$test->{$plural}} ) { my $meth = "get_$plural"; my @foo = $obj->$meth; is(scalar(@foo), scalar(@tfoo), - "${t_name}Table $tbl_name has ".scalar(@tfoo)." $plural"); + "${t_name}$obj_name has ".scalar(@tfoo)." $plural"); foreach ( @foo ) { - my $ans = { table => $obj->name, %{shift @tfoo}}; + my $ans = { lc($obj_name) => $obj->name, %{shift @tfoo}}; + #my $ans = shift @tfoo; my $meth = "${foo}_ok"; { no strict 'refs'; $meth->( $_, $ans, $name ); @@ -359,10 +387,42 @@ sub table_ok { } } + + sub schema_ok { my ($obj,$test,$name) = @_; my $t_name = t_name($name); default_attribs($test,"schema"); + + is( $obj->name, $test->{name}, "${t_name}Schema name is '$test->{name}'" ); + + is( $obj->database, $test->{database}, + "$t_name database is '$test->{database}'" ); + + is( $obj->is_valid, $test->{is_valid}, + "$t_name is ".($test->{is_valid} ? '' : 'not ').'valid' ); + + # Tables + if ( $test->{tables} ) { + is_deeply( [ map {$_->name} $obj->get_tables ], + [ map {$_->{name}} @{$test->{tables}} ], + "${t_name} table names match" ); + foreach ( @{$test->{tables}} ) { + my $t_name = $_->{name} || die "Need a table name to test."; + table_ok( $obj->get_table($t_name), $_, $name ); + } + } + else { + is(scalar($obj->get_tables), undef, + "${t_name} has no tables."); + } + + # Procedures, Triggers, Views + _test_kids($obj, $test, $name, { + procedure => "procedures", + trigger => "triggers", + view => "views", + }); } 1; # compile please ===========================================================