Menu
▾
▴
[Discnw-checkins] discnw/src/perl/t 03Database.t,NONE,1.1 01Error.t,1.4,1.5 02CGI.t,1.1,1.2 02Database.t,1.5,1.6 03Event_Hat.t,1.2,1.3 03Event_Team.t,1.2,1.3
|
From: Geoffrey T. D. <da...@us...> - 2005-02-16 20:50:17
|
Update of /cvsroot/discnw/discnw/src/perl/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8188/t Modified Files: 01Error.t 02CGI.t 02Database.t 03Event_Hat.t 03Event_Team.t Added Files: 03Database.t Log Message: More tests, more bug fixes, more documentation. Index: 01Error.t =================================================================== RCS file: /cvsroot/discnw/discnw/src/perl/t/01Error.t,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- 01Error.t 1 Feb 2005 21:52:32 -0000 1.4 +++ 01Error.t 16 Feb 2005 20:50:03 -0000 1.5 @@ -47,5 +47,7 @@ is ($err3->field_name, 'year', ' field_name'); is ($err3->bad_value, 123, ' bad_value'); - +# FIXME: how to test debugging (stack trace output) +# I'm not sure it's possible. + Index: 02CGI.t =================================================================== RCS file: /cvsroot/discnw/discnw/src/perl/t/02CGI.t,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- 02CGI.t 15 Feb 2005 21:01:52 -0000 1.1 +++ 02CGI.t 16 Feb 2005 20:50:03 -0000 1.2 @@ -10,7 +10,7 @@ my $db = ALE::Util::TestLib::get_database(); plan ($db - ? (tests => 13) + ? (tests => 14) : (skip_all => "Can't connect to database")); ok($db, "db"); diag("Prefix: " . $db->prefix); @@ -41,3 +41,14 @@ ok($cgi2, "cgi2"); is($sessid, $cgi2->session->id, "check session id"); is($cgi2->session->param('test_junk'), 'howdy', 'cgi2->session->param'); + + +# Check that changing session table name generates a warning +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning .= $_[0]; }; + + ALE::CGI::_set_session_table_name('xxx_junk_Foo'); + + like($warning, qr(table name changed), "_set_session_table_name"); +} --- NEW FILE: 03Database.t --- #!/usr/bin/perl -w # -*-perl-*- # $Id: 03Database.t,v 1.1 2005/02/16 20:50:04 dairiki Exp $ use strict; use Test::More; use Test::Harness qw($verbose); use ALE::Error qw(:try -debug); use ALE::Database qw(get_database); use ALE::Util::TestLib qw(raises); use ALE::Leagues::Event; my $db = ALE::Util::TestLib::get_database(); plan ($db ? (tests => 8) : (skip_all => "Can't connect to database")); ok($db, "get_database"); # Test getMapTable my $table = $db->getMapTable('BidStatusMap.bid_status'); ok($table, 'getMapTable'); my $pending = $table->coerce_to_key("pending"); ok($pending, "pending = $pending"); is($db->getMapTable('BidStatusMap.bid_status')."", "$table", "caching"); # Test getEvent my $event = new ALE::Leagues::Event::Hat $db, 'name' => 'Test Event', 'timespan' => [ start => 'NOW' ]; ok($event, "event"); is($db->getEvent($event->id)->name, 'Test Event', "getEvent"); # Test getEvents my @events = $db->getEvents('all'); ok(@events > 0, "getEvents got some events"); my @pick = grep { $_->id == $event->id } @events; is(@pick, 1, "getEvents got my event"); Index: 02Database.t =================================================================== RCS file: /cvsroot/discnw/discnw/src/perl/t/02Database.t,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- 02Database.t 1 Feb 2005 21:52:33 -0000 1.5 +++ 02Database.t 16 Feb 2005 20:50:04 -0000 1.6 @@ -10,17 +10,24 @@ my $db = ALE::Util::TestLib::get_database(); plan ($db - ? (tests => 7) + ? (tests => 10) : (skip_all => "Can't connect to database")); ok($db, "get_database"); ok($db->dbh, "dbh"); diag("Prefix: " . $db->prefix); +# Test the connection cache +is($db, get_database, "get_database"); + raises { - ALE::Database::get_database('bad dsn', 'bad user', 'bad password'); + get_database('dbi:mysql:database=junk_bad_database', + 'bad user', 'bad password'); } 'ALE::DatabaseError', "get_database(bad args)"; +raises { + get_database('dbi:mysql:database=junk_bad_database'); +} 'ALE::DatabaseError', "get_database(bad args)"; use ALE::Config qw($DATABASE_DSN $DATABASE_USER $DATABASE_PASSWORD); @@ -32,3 +39,7 @@ is(@pfx_tables, 2, 'prefix(arg)'); is($pfx_tables[0], 'test_junk_pfx_Foo', 'Foo'); is($pfx_tables[1], 'test_junk_pfx_Bar', 'Bar'); + +is($pfx_db->hackTablePrefixes("SELECT Foo.bar Bar.baz FROM"), + "SELECT test_junk_pfx_Foo.bar test_junk_pfx_Bar.baz FROM", + "hackTablePrefixes"); Index: 03Event_Hat.t =================================================================== RCS file: /cvsroot/discnw/discnw/src/perl/t/03Event_Hat.t,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- 03Event_Hat.t 16 Feb 2005 03:59:54 -0000 1.2 +++ 03Event_Hat.t 16 Feb 2005 20:50:04 -0000 1.3 @@ -20,7 +20,7 @@ my $db = ALE::Util::TestLib::get_database(); plan $db - ? (tests => 64) + ? (tests => 66) : (skip_all => "Can't connect to database"); ok($db, "get_database"); @@ -99,7 +99,7 @@ # Test coordinator stuff. $event->setCoordinators(42, 43); pass("setCoordinators"); -my @coords = $event->getCoordinatorsIds(); +my @coords = $event->getCoordinatorIds(); is(scalar(@coords), 2, "two coords"); ok(grep($_ == 42, @coords), "42 in coords"); ok(grep($_ == 43, @coords), "43 in coords"); @@ -208,6 +208,14 @@ "operation on deleted record"; +################################################################ +# test getCoordinators + +$event->setCoordinators($ind); +my @coordinators = $event->getCoordinators; +is(@coordinators, 1, "getCoordinators"); +is($coordinators[0]->id, $ind->id, "getCoordinators"); + # Exercise -check code in hat event my $teamevent = new ALE::Leagues::Event::Team $db, Index: 03Event_Team.t =================================================================== RCS file: /cvsroot/discnw/discnw/src/perl/t/03Event_Team.t,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- 03Event_Team.t 16 Feb 2005 03:59:54 -0000 1.2 +++ 03Event_Team.t 16 Feb 2005 20:50:04 -0000 1.3 @@ -97,7 +97,7 @@ # Test coordinator stuff. $event->setCoordinators(42, 43); pass("setCoordinators"); -my @coords = $event->getCoordinatorsIds(); +my @coords = $event->getCoordinatorIds(); is(scalar(@coords), 2, "two coords"); ok(grep($_ == 42, @coords), "42 in coords"); ok(grep($_ == 43, @coords), "43 in coords"); |