Author: turnstep
Date: Sat Jan 12 11:36:46 2008
New Revision: 10526
Modified:
DBD-Pg/trunk/t/01connect.t
Log:
Clean up, bail if no DSN, improve the diag section greatly.
Modified: DBD-Pg/trunk/t/01connect.t
==============================================================================
--- DBD-Pg/trunk/t/01connect.t (original)
+++ DBD-Pg/trunk/t/01connect.t Sat Jan 12 11:36:46 2008
@@ -3,20 +3,18 @@
# Make sure we can connect and disconnect cleanly
# All tests are stopped if we cannot make the first connect
-use Test::More;
-use DBI;
use strict;
-select((select(STDERR),$|=1)[0]);
-$|=1;
+use warnings;
+use DBI;
+use Test::More tests => 15;
+select(($|=1,select(STDERR),$|=1)[1]);
## Define this here in case we get to the END block before a connection is
made.
my ($pgversion,$pglibversion,$pgvstring,$pgdefport) = ('?','?','?','?');
my $bail = 0;
-if (defined $ENV{DBI_DSN}) {
- plan tests => 15;
-} else {
- BAIL_OUT "DBI_DSN must be set";
+if (!defined $ENV{DBI_DSN}) {
+ BAIL_OUT 'Cannot run tests unless DBI_DSN is defined. See the README
file';
}
# Trapping a connection error can be tricky, but we only have to do it
@@ -25,18 +23,18 @@
# the second is an invalid login, usually a bad DBI_USER or DBI_PASS
my ($dbh,$t);
+
eval {
$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, PrintError => 0, AutoCommit => 0});
};
if ($@) {
if (! $DBI::errstr) {
- print STDOUT "Bail out! Could not connect: [EMAIL PROTECTED]";
+ BAIL_OUT "Could not connect: $@";
}
else {
- print STDOUT "Bail out! Could not connect: $DBI::errstr\n";
+ BAIL_OUT "Could not connect: $DBI::errstr";
}
- exit; # Force a hasty exit
}
pass('Established a connection to the database');
@@ -44,7 +42,7 @@
$pgversion = $dbh->{pg_server_version};
$pglibversion = $dbh->{pg_lib_version};
$pgdefport = $dbh->{pg_default_port};
-$pgvstring = $dbh->selectall_arrayref("SELECT VERSION();")->[0][0];
+$pgvstring = $dbh->selectall_arrayref('SELECT VERSION()')->[0][0];
ok( $dbh->disconnect(), 'Disconnect from the database');
@@ -72,7 +70,7 @@
SKIP: {
my $alias = qr{(database|db|dbname)};
if ($ENV{DBI_DSN} !~ /$alias\s*=\s*\S+/) {
- skip "DBI_DSN contains no database option, so skipping
connection tests", 4;
+ skip 'DBI_DSN contains no database option, so skipping
connection tests', 4;
}
$t=q{Connect with invalid option fails};
@@ -92,7 +90,7 @@
}
if ($ENV{DBI_DSN} =~ /$alias\s*=\s*"/) {
- skip "DBI_DSN already contains quoted database, no need for
explicit test", 1;
+ skip 'DBI_DSN already contains quoted database, no need for
explicit test', 1;
}
$t=q{Connect using a quoted database argument};
($dbi = $ENV{DBI_DSN}) =~ s/$alias\s*=(\w+)/'db="'.lc $2.'"'/e;
@@ -115,19 +113,30 @@
is($@, q{}, $t);
END {
- my $pv = sprintf("%vd", $^V);
- my $schema = exists $ENV{DBD_SCHEMA} ?
- "\nDBD_SCHEMA $ENV{DBD_SCHEMA}" : '';
+ my $pv = sprintf('%vd', $^V);
+ my $schema = exists $ENV{DBD_SCHEMA} ? $ENV{DBD_SCHEMA} :
'dbd_pg_testschema';
my $dsn = exists $ENV{DBI_DSN} ? $ENV{DBI_DSN} : '?';
my $ver = defined $DBD::Pg::VERSION ? $DBD::Pg::VERSION : '?';
- diag
- "\nProgram Version\n".
- "Perl $pv ($^O)\n".
- "DBD::Pg $ver\n".
+ my $user = exists $ENV{DBI_USER} ? $ENV{DBI_USER} : '<not set>';
+
+ my $extra = '';
+ for (sort qw/HOST HOSTADDR PORT DATABASE USER PASSWORD OPTIONS SERVICE
SSLMODE SYSCONFDIR/) {
+ my $name = "PG$_";
+ if (exists $ENV{$name} and defined $ENV{$name}) {
+ $extra .= sprintf "\n%-21s $ENV{$name}", $name;
+ }
+ }
+
+ diag
+ "\nDBI Version $DBI::VERSION\n".
+ "DBD::Pg Version $ver\n".
+ "Perl Version $pv\n".
+ "OS $^O\n".
"PostgreSQL (compiled) $pglibversion\n".
"PostgreSQL (target) $pgversion\n".
"PostgreSQL (reported) $pgvstring\n".
"Default port $pgdefport\n".
- "DBI $DBI::VERSION\n".
- "DBI_DSN $dsn$schema\n";
+ "DBI_DSN $dsn\n".
+ "DBI_USER $user\n".
+ "Test schema $schema$extra\n";
}
