[svn-inject] Installing original source of libtest-database-perl (1.11)

18 files changed, 775 insertions, 0 deletions

diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..43061b9
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Find;
+
+my @modules;
+find( sub { push @modules, $File::Find::name if /\.pm$/ }, 'blib/lib' );
+
+plan tests => scalar @modules;
+
+use_ok($_)
+    for reverse sort map { s!/!::!g; s/\.pm$//; s/^blib::lib:://; $_ }
+    @modules;
+
+diag("Tested Test::Database $Test::Database::VERSION, Perl $], $^X");
+
diff --git a/t/08-handle.t b/t/08-handle.t
new file mode 100644
index 0000000..474fe01
--- /dev/null
+++ b/t/08-handle.t
@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database::Handle;
+use List::Util qw( sum );
+
+my @tests = (
+
+    # args, expected result, error regex
+    [ [], undef, qr/^dsn argument required/ ],
+    [ [ dbd => 'Zlonk' ], undef, qr/^dsn argument required/ ],
+    [   [ driver => 'Foo', dsn => 'dbi:SQLite:dbname=zlonk' ],
+        {   dsn      => 'dbi:SQLite:dbname=zlonk',
+            username => '',
+            password => '',
+            dbd      => 'SQLite',
+            driver   => 'Foo',
+        }
+    ],
+    [   [   dbd  => 'SQLite',
+            dsn  => 'dbi:SQLite:dbname=zlonk',
+            name => 'zlonk'
+        ],
+        {   dsn      => 'dbi:SQLite:dbname=zlonk',
+            username => '',
+            password => '',
+            dbd      => 'SQLite',
+            name     => 'zlonk',
+        }
+    ],
+);
+my @attr = qw( dsn username password dbd );
+
+plan tests => sum map { $_->[2] ? 1 : 1 + @attr } @tests;
+
+for my $t (@tests) {
+    my ( $args, $expected, $err ) = @$t;
+
+    my $got = eval { Test::Database::Handle->new(@$args) };
+    my $call = "Test::Database::Handle->new( "
+        . join( ', ', map {"'$_'"} @$args ) . " )";
+
+    if ($@) {
+        like( $@, $err, "Expected error message for $call" );
+    }
+    else {
+        isa_ok( $got, 'Test::Database::Handle' );
+        is( $got->$_, $expected->{$_}, "$_ for $call" ) for @attr;
+    }
+}
+
diff --git a/t/09-handle-dsn.t b/t/09-handle-dsn.t
new file mode 100644
index 0000000..91237fc
--- /dev/null
+++ b/t/09-handle-dsn.t
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database::Handle;
+
+use DBI;
+use File::Spec;
+use File::Temp qw( tempdir );
+
+my $dir = tempdir( CLEANUP => 1 );
+my $db = File::Spec->catfile( $dir, 'db.sqlite' );
+
+my $dsn = "dbi:SQLite:$db";
+my $dbh;
+eval { $dbh = DBI->connect($dsn) }
+    or plan skip_all => 'DBD::SQLite needed for this test';
+
+# some SQL statements to try out
+my @sql = (
+    q{CREATE TABLE users (id INTEGER, name VARCHAR(64))},
+    q{INSERT INTO users (id, name) VALUES (1, 'book')},
+    q{INSERT INTO users (id, name) VALUES (2, 'echo')},
+);
+my $select = "SELECT id, name FROM users";
+
+plan tests => @sql + 4;
+
+# create some information
+ok( $dbh->do($_), $_ ) for @sql;
+
+# create handle
+my $handle = Test::Database::Handle->new( dsn => $dsn );
+
+is_deeply(
+    [ $handle->connection_info() ],
+    [ $dsn, '', '' ],
+    'connection_info()'
+);
+isa_ok( my $dbh2 = $handle->dbh(), 'DBI::db' );
+cmp_ok( $handle->dbh(), 'eq', $dbh2, 'cached dbh' );
+
+# check the data is there
+my $lines = $dbh->selectall_arrayref($select);
+is_deeply( $lines, [ [ 1, 'book' ], [ 2, 'echo' ] ], $select );
+
diff --git a/t/10-drivers.t b/t/10-drivers.t
new file mode 100644
index 0000000..37845c9
--- /dev/null
+++ b/t/10-drivers.t
@@ -0,0 +1,106 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database;
+use Test::Database::Driver;
+
+# for file-based drivers, the dbd parameter is enough
+# but for other drivers, we'll need the driver_dsn, username and password
+my @drivers = (
+    map {
+        my $d = $_;
+        +{ map { $_ => $d->{$_} }
+                grep { exists $d->{$_} }
+                qw( driver_dsn dbd username password ) }
+        } Test::Database->drivers()
+);
+
+plan tests => 5 + @drivers * ( 1 + 2 * 12 ) + 2;
+
+my $base = 'Test::Database::Driver';
+
+# tests for Test::Database::Driver directly
+{
+    ok( !eval { Test::Database::Driver->new(); 1 },
+        'Test::Database::Driver->new() failed'
+    );
+    like(
+        $@,
+        qr/^dbd or driver_dsn parameter required at/,
+        'Expected error message'
+    );
+    my $dir = $base->base_dir();
+    ok( $dir, "$base has a base_dir(): $dir" );
+    like( $dir, qr/Test-Database-.*/,
+        "$base\'s base_dir() looks like expected" );
+    ok( -d $dir, "$base base_dir() is a directory" );
+}
+
+# now test the subclasses
+
+for my $args (@drivers) {
+    my $name  = $args->{dbd};
+    my $class = "Test::Database::Driver::$name";
+    use_ok($class);
+
+    for my $t (
+        [ $base  => eval { $base->new(%$args) }  || ( '', $@ ) ],
+        [ $class => eval { $class->new(%$args) } || ( '', $@ ) ],
+        )
+    {
+        my ( $created_by, $driver, $at ) = @$t;
+        $at =~ s/ at .*\n// if $at;
+    SKIP: {
+            skip "Failed to create $name driver with $created_by ($at)", 12
+                if !$driver;
+            diag "$name driver (created by $created_by)";
+
+            # class and name
+            my $desc = "$name driver";
+            isa_ok( $driver, $class, $desc );
+            is( $driver->name(), $name, "$desc has the expected name()" );
+
+            # base_dir
+            my $dir = $driver->base_dir();
+            ok( $dir, "$desc has a base_dir(): $dir" );
+            like( $dir, qr/Test-Database-.*\Q$name\E/,
+                "$desc\'s base_dir() looks like expected" );
+            ok( -d $dir, "$desc base_dir() is a directory" );
+
+            # version
+            my $version;
+            ok( eval { $version = $driver->version() },
+                "$desc has a version(): $version"
+            );
+            diag $@ if $@;
+            isa_ok( $version, 'version', "$desc version()" );
+
+            # version_dbd
+            my $version_dbd;
+            ok( eval { $version_dbd = $driver->dbd_version() },
+                "$desc has a dbd_version(): $version_dbd"
+            );
+            diag $@ if $@;
+
+            # driver_dsn, username, password, connection_info
+            ok( $driver->driver_dsn(),       "$desc has a driver_dsn()" );
+            ok( defined $driver->username(), "$desc has a username()" );
+            ok( defined $driver->password(), "$desc has a password()" );
+            is_deeply(
+                [ $driver->connection_info() ],
+                [ map { $driver->$_ } qw< driver_dsn username password > ],
+                "$desc has a connection_info()"
+            );
+        }
+    }
+}
+
+# get all loaded drivers
+@drivers = Test::Database->list_drivers();
+cmp_ok( scalar @drivers, '>=', 1, 'At least one driver loaded' );
+
+# unload them
+Test::Database->clean_config();
+@drivers = Test::Database->list_drivers();
+is( scalar @drivers, 0, 'All drivers were unloaded' );
+
diff --git a/t/10-list_drivers.t b/t/10-list_drivers.t
new file mode 100644
index 0000000..b7aa77f
--- /dev/null
+++ b/t/10-list_drivers.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database;
+
+# hardcoded sorted list of our drivers
+my @all_drivers = sort qw( CSV DBM Pg SQLite SQLite2 mysql );
+
+# intersection with DBI->available_drivers
+my %all_drivers = map { $_ => 1 } @all_drivers;
+my @available_drivers
+    = sort grep { exists $all_drivers{$_} } DBI->available_drivers;
+
+plan tests => 3;
+
+# minimal setup
+Test::Database->clean_config();
+Test::Database->load_drivers();
+
+# existing Test::Database::Driver:: drivers
+is_deeply( [ Test::Database->list_drivers('all') ],
+    \@all_drivers, q{list_drivers('all')} );
+
+# available DBI drivers
+is_deeply( [ Test::Database->list_drivers('available') ],
+    \@available_drivers, q{list_drivers('available')} );
+
+# available DBI drivers we could load (should only be file-based)
+my @filebased
+    = grep { "Test::Database::Driver::$_"->is_filebased() } @available_drivers;
+is_deeply( [ Test::Database->list_drivers() ], \@filebased,
+    'list_drivers()' );
+
diff --git a/t/11-available_dbname.t b/t/11-available_dbname.t
new file mode 100644
index 0000000..57e180e
--- /dev/null
+++ b/t/11-available_dbname.t
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database::Driver;
+
+# fake the databases() method
+my @db;
+{
+    no strict;
+    @{"Test::Database::Driver::Zlonk::ISA"} = qw( Test::Database::Driver );
+    *{"Test::Database::Driver::Zlonk::databases"} = sub {@db};
+}
+
+# our test plans
+my @names = ( 0, 1, 3, 2, 4 );
+my @expected = ( 0, 1, 2, 2, 4, 5 );
+
+plan tests => 4 + @expected;
+
+# check the basename
+like( Test::Database::Driver::Zlonk->_basename(),
+    qr/^tdd_zlonk_\w+_$/, "_basename looks correct" );
+
+# test _set_key
+my $bad = 'a b c';
+ok( !eval { Test::Database::Driver->_set_key($bad); 1 }, "Bad key: $bad" );
+like( $@, qr/^Invalid format for key '$bad' at/, 'Expected error message' );
+
+# set a correct key
+Test::Database::Driver->_set_key('clunk');
+like( Test::Database::Driver::Zlonk->_basename(),
+    qr/^tdd_zlonk_\w+_clunk_$/, "_basename looks correct (with key)" );
+
+# now correctly compute our expectations
+my $dbname = Test::Database::Driver::Zlonk->_basename();
+@names    = map {"$dbname$_"} @names;
+@expected = map {"$dbname$_"} @expected;
+
+for my $expected (@expected) {
+    is( Test::Database::Driver::Zlonk->available_dbname(),
+        $expected, "available_dbname() = $expected" );
+    push @db, shift @names;
+}
+
diff --git a/t/11-make_dsn.t b/t/11-make_dsn.t
new file mode 100644
index 0000000..7d56afd
--- /dev/null
+++ b/t/11-make_dsn.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database::Driver;
+use version;
+
+# test version_matches() on a dummy driver
+
+my @tests = (
+    [ '', 'dbi:Dummy:' ],
+    [ '', 'dbi:Dummy:bam=boff',             qw( bam boff ) ],
+    [ '', 'dbi:Dummy:bam=boff;z_zwap=plop', qw( bam boff z_zwap plop ) ],
+    [   'dbi:Dummy:bam=boff', 'dbi:Dummy:bam=boff;z_zwap=plop',
+        qw( z_zwap plop )
+    ],
+    [   'dbi:Dummy:bam=boff',
+        'dbi:Dummy:bam=boff;z_zwap=plop;zowie=sock',
+        qw( z_zwap plop zowie sock )
+    ],
+);
+
+@Test::Database::Driver::Dummy::ISA = qw( Test::Database::Driver );
+
+plan tests => scalar @tests;
+
+for my $t (@tests) {
+    my ( $driver_dsn, $dsn, @args ) = @$t;
+    my $driver = bless { driver_dsn => $driver_dsn },
+        'Test::Database::Driver::Dummy';
+
+    my $got = $driver->make_dsn(@args);
+    is( $got, $dsn, $driver->driver_dsn() . ' ' . to_string(@args) );
+}
+
+sub to_string {
+    my %args = @_;
+    return
+        '( ' . join( ', ', map {"$_ => $args{$_}"} sort keys %args ) . ' )';
+}
+
diff --git a/t/11-version_matches.t b/t/11-version_matches.t
new file mode 100644
index 0000000..5e64ea3
--- /dev/null
+++ b/t/11-version_matches.t
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database::Driver;
+use version;
+
+# test version_matches() on a dummy driver
+
+my @requests;
+
+my @ok = (
+    {},
+    { version     => '1.2.3' },
+    { min_version => '1.2.2' },
+    { min_version => '1.2.3' },
+    { max_version => '1.3.0' },
+    { version     => '1.2.3', min_version => '1.2.0' },
+    { version     => '1.2.3', max_version => '1.4.3' },
+    { min_version => '1.2.0', max_version => '2.0' },
+    { version     => '1.2.3', min_version => '1.2.0', max_version => '2.0' },
+    { regex_version => qr/^1\.2/ },
+);
+
+my @ok_beta
+    = map { my %r = %$_; $r{version} = '1.2.3-beta' if $r{version}; \%r } @ok;
+push @ok_beta, { regex_version => qr/beta/ };
+
+my @not_ok = (
+    { min_version   => '1.3.0' },
+    { max_version   => '1.002' },
+    { max_version   => '1.2.3' },
+    { version       => '1.2.3-beta' },
+    { version       => '1.3.4' },
+    { min_version   => '1.3.0', max_version => '2.1' },
+    { min_version   => '0.1.3', max_version => '1.002' },
+    { regex_version => qr/^1\.2\.[1245]$/ },
+    { regex_version => qr/^1\.2$/ },
+);
+
+my @not_ok_beta = map {
+    my %r = %$_;
+    $r{version} = '1.2.3' if $r{version} && $r{version} eq '1.2.3-beta';
+    \%r
+} @not_ok;
+
+# define our dummy class
+package Test::Database::Driver::Dummy;
+our @ISA = qw( Test::Database::Driver );
+sub _version { $_[0]{xxx} || '1.2.3' }
+
+package main;
+my $driver = bless {}, 'Test::Database::Driver::Dummy';
+my $driver_beta = bless { xxx => '1.2.3-beta' },
+    'Test::Database::Driver::Dummy';
+
+plan tests => @ok + @not_ok + @ok_beta + @not_ok_beta;
+
+for my $request (@ok) {
+    ok( $driver->version_matches($request),
+        to_string($request) . ' matches driver'
+    );
+}
+
+for my $request (@not_ok) {
+    ok( !$driver->version_matches($request),
+        to_string($request) . ' does not match driver' );
+}
+
+for my $request (@ok_beta) {
+    ok( $driver_beta->version_matches($request),
+        to_string($request) . ' matches beta driver'
+    );
+}
+
+for my $request (@not_ok_beta) {
+    ok( !$driver_beta->version_matches($request),
+        to_string($request) . ' does not match beta driver'
+    );
+}
+
+sub to_string {
+    my ($request) = @_;
+    return
+          '{ '
+        . join( ', ', map {"$_ => $request->{$_}"} sort keys %$request )
+        . ' }';
+}
+
diff --git a/t/12-load.t b/t/12-load.t
new file mode 100644
index 0000000..b18640c
--- /dev/null
+++ b/t/12-load.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Database::Util;
+use File::Spec;
+
+my @good = (
+    {   dsn      => 'dbi:mysql:database=mydb;host=localhost;port=1234',
+        username => 'user',
+        password => 's3k r3t',
+    },
+    {   dsn      => 'dbi:mysql:database=mydb;host=remotehost;port=5678',
+        username => 'otheruser',
+    },
+    { dsn => 'dbi:SQLite:db.sqlite' },
+    {   driver_dsn => 'dbi:mysql:host=remotehost;port=5678',
+        username   => 'otheruser',
+    },
+);
+
+my @bad = (
+    [   File::Spec->catfile(qw< t database.bad >),
+        qr/^Can't parse line at .*, line \d+:\n  <bad format> at /
+    ],
+    [   File::Spec->catfile(qw< t database.bad2 >),
+        qr/^Record doesn't start with dsn or driver_dsn .*, line \d+:\n  <drh      = dbi:mysql:> at /
+    ],
+    [ 'missing', qr/^Can't open missing for reading: / ],
+);
+
+plan tests => 1 + @good + 2 * @bad + 1;
+
+# load a correct file
+my $file   = File::Spec->catfile(qw< t database.good >);
+my @config = _read_file($file);
+
+is( scalar @config, scalar @good,
+    "Got @{[scalar @good]} handles from $file" );
+
+for my $test (@good) {
+    my $args = shift @config;
+    is_deeply( $args, $test,
+        "Read args for handle " . ( $test->{dsn} || $test->{driver_dsn} ) );
+}
+
+# try to load a bad file
+for my $t (@bad) {
+    my ( $file, $regex ) = @$t;
+    ok( !eval { _read_file($file); 1 }, "_read_file( $file ) failed" );
+    like( $@, $regex, 'Expected error message' );
+}
+
+# load an empty file
+$file = File::Spec->catfile(qw< t database.empty >);
+is( scalar _read_file($file), 0, 'Empty file' );
+
diff --git a/t/20-handles.t b/t/20-handles.t
new file mode 100644
index 0000000..be2fdbb
--- /dev/null
+++ b/t/20-handles.t
@@ -0,0 +1,106 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Spec;
+use Test::Database;
+
+my %handle = (
+    mysql1 => Test::Database::Handle->new(
+        dsn      => 'dbi:mysql:database=mydb;host=localhost;port=1234',
+        username => 'user',
+        password => 's3k r3t',
+    ),
+    mysql2 => Test::Database::Handle->new(
+        dsn      => 'dbi:mysql:database=mydb;host=remotehost;port=5678',
+        username => 'otheruser',
+    ),
+    sqlite => Test::Database::Handle->new( dsn => 'dbi:SQLite:db.sqlite', ),
+);
+delete $_->{driver} for values %handle;
+
+# test description:
+# 1st char is variable to look at: array (@) or scalar ($)
+# 2nd char is expected result: list (@), single item ($) or number (1)
+my @code;
+my %tests = map {
+    my ( $fmt, $code ) = split / /, $_, 2;
+    push @code, $code;
+    ( $code => $fmt )
+} split /\n/, << 'CODE';
+@@ @handles = Test::Database->handles(@requests);
+$1 $handle  = Test::Database->handles(@requests);
+$$ $handle  = ( Test::Database->handles(@requests) )[0];
+$$ ($handle) = Test::Database->handles(@requests);
+$$ $handle  = Test::Database->handle(@requests);
+@$ @handles = Test::Database->handle(@requests);
+CODE
+
+my @tests = (
+
+    # request, expected response
+    [ [],        [ @handle{qw( mysql1 mysql2 sqlite )} ], '' ],
+    [ ['mysql'], [ @handle{qw( mysql1 mysql2 )} ],        q{'mysql'} ],
+    [ ['sqlite'], [], q{'sqlite'} ],
+    [ ['SQLite'], [ $handle{sqlite} ], q{'SQLite'} ],
+    [ ['Oracle'], [], q{'Oracle'} ],
+    [   [ 'SQLite', 'mysql' ],
+        [ @handle{qw( mysql1 mysql2 sqlite )} ],
+        q{'SQLite', 'mysql'}
+    ],
+    [   [ 'mysql', 'SQLite', 'mysql' ],
+        [ @handle{qw( mysql1 mysql2 sqlite )} ],
+        q{'mysql', 'SQLite', 'mysql'}
+    ],
+    [   [ 'mysql', 'Oracle', 'SQLite' ],
+        [ @handle{qw( mysql1 mysql2 sqlite )} ],
+        q{'Oracle', 'mysql', 'SQLite'}
+    ],
+    [ [ { dbd => 'mysql' } ], [ @handle{qw( mysql1 mysql2 )} ], q{'mysql'} ],
+    [   [ { driver => 'mysql' } ],
+        [ @handle{qw( mysql1 mysql2 )} ],
+        q{'mysql'}
+    ],
+
+);
+
+# reset the internal structures and force loading our test config
+Test::Database->clean_config();
+my $config = File::Spec->catfile( 't', 'database.rc' );
+Test::Database->load_config( $config );
+
+plan tests => @tests * keys %tests;
+
+for my $test (@tests) {
+    my ( $requests, $responses, $desc ) = @$test;
+    my %expected = (
+        '1' => [ scalar @$responses ],
+        '$' => [ $responses->[0] ],
+        '@' => $responses,
+        '0' => [],
+    );
+
+    # try out each piece of code
+    my @requests = @$requests;
+    for my $code (@code) {
+        my ( $handle, @handles );
+        my ( $got, $expected ) = split //, $tests{$code};
+
+        # special case
+        $expected = '0' if $tests{$code} eq '@$' && !@$responses;
+
+        # run the code
+        eval "$code; 1;" or do {
+            ok( 0, $code );
+            diag $@;
+            next;
+        };
+        ( my $mesg = $code ) =~ s/\@requests/$desc/;
+        $got
+            = $got eq '$' ? [$handle]
+            : $got eq '@' ? \@handles
+            :               die "Unknown variable symbol $got";
+        ref && delete $_->{driver} for @$got;
+        is_deeply( $got, $expected{$expected}, $mesg );
+    }
+}
+
diff --git a/t/25-sql.t b/t/25-sql.t
new file mode 100644
index 0000000..6f6d8d0
--- /dev/null
+++ b/t/25-sql.t
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Spec;
+
+# DBD::DBM uses SQL::Statement if available
+# but SQL::Statement versions > 1.20 make the test fail
+# (see RT #56463, #56561)
+BEGIN {
+    if ( eval { require SQL::Statement; $SQL::Statement::VERSION > 1.20; } ) {
+       $ENV{DBI_SQL_NANO} = 1;
+    }
+}
+
+use Test::Database;
+
+my @drivers = Test::Database->drivers();
+@drivers = grep {
+    my $name = $_->name();
+    grep { $name eq $_ } @ARGV
+} @drivers if @ARGV;
+
+plan skip_all => 'No drivers available for testing' if !@drivers;
+
+# some SQL statements to try out
+my @sql = (
+    q{CREATE TABLE users (id INTEGER, name VARCHAR(64))},
+    q{INSERT INTO users (id, name) VALUES (1, 'book')},
+    q{INSERT INTO users (id, name) VALUES (2, 'echo')},
+);
+my $select = "SELECT id, name FROM users";
+my $drop   = 'DROP TABLE users';
+
+plan tests => ( 1 + ( 3 + @sql + 1 ) * 2 + 1 + 2) * @drivers;
+
+for my $driver (@drivers) {
+    my $drname = $driver->name();
+    diag "Testing driver $drname " . $driver->version()
+        . ", DBD::$drname " . $driver->dbd_version();
+    isa_ok( $driver, 'Test::Database::Driver' );
+
+    my $count = 0;
+    my $old;
+    for my $request (
+        $drname,
+        { dbd => $drname },
+        )
+    {
+
+        # database handle to a database (created by the driver)
+        my ($handle) = Test::Database->handles($request);
+        my $dbname = $handle->{name};
+        isa_ok( $handle, 'Test::Database::Handle', "$drname $dbname" );
+
+        # check we always get the same database, when it's created
+        is( $dbname, $old, "Got db $old again" ) if $old;
+        $old ||= $dbname;
+
+        # do some tests on the dbh
+        my $desc = "$drname($dbname)";
+        my $dbh  = $handle->dbh();
+        isa_ok( $dbh, 'DBI::db' );
+
+        # create some information
+        ok( $dbh->do($_), "$desc: $_" ) for @sql;
+
+        # check the data is there
+        my $lines = $dbh->selectall_arrayref($select);
+        is_deeply(
+            $lines,
+            [ [ 1, 'book' ], [ 2, 'echo' ] ],
+            "$desc: $select"
+        );
+
+        # remove everything
+        ok( $dbh->do($drop), "$desc: $drop" );
+        $dbh->disconnect();
+    }
+
+    ok( grep ( { $_ eq $old } $driver->databases() ),
+        "Database $old still there" );
+    $driver->drop_database($old);
+    ok( !grep ( { $_ eq $old } $driver->databases() ),
+        "Database $old was dropped" );
+}
+
diff --git a/t/database.bad b/t/database.bad
new file mode 100644
index 0000000..b72ee06
--- /dev/null
+++ b/t/database.bad
@@ -0,0 +1,14 @@
+# example correct .test-database.rc file
+
+# mysql
+driver_dsn = mysql
+host       = localhost
+username = root
+password = "s3k r3t"
+
+bad format
+
+driver = SQLite
+
+driver = CSV
+
diff --git a/t/database.bad2 b/t/database.bad2
new file mode 100644
index 0000000..e779a94
--- /dev/null
+++ b/t/database.bad2
@@ -0,0 +1,3 @@
+drh      = dbi:mysql:
+username = root
+
diff --git a/t/database.empty b/t/database.empty
new file mode 100644
index 0000000..cc0dae7
--- /dev/null
+++ b/t/database.empty
@@ -0,0 +1,4 @@
+# example correct .test-database.rc file
+
+# but empty
+
diff --git a/t/database.good b/t/database.good
new file mode 100644
index 0000000..28b8a7d
--- /dev/null
+++ b/t/database.good
@@ -0,0 +1,17 @@
+# example correct .test-database.rc file
+
+# mysql
+dsn      = dbi:mysql:database=mydb;host=localhost;port=1234
+username = user
+password = s3k r3t
+
+# another
+dsn      = dbi:mysql:database=mydb;host=remotehost;port=5678
+username = otheruser
+
+# sqlite
+dsn      = dbi:SQLite:db.sqlite
+
+# a database driver
+driver_dsn = dbi:mysql:host=remotehost;port=5678
+username   = otheruser
diff --git a/t/database.rc b/t/database.rc
new file mode 100644
index 0000000..f6349c9
--- /dev/null
+++ b/t/database.rc
@@ -0,0 +1,14 @@
+# example correct .test-database.rc file
+
+# mysql
+dsn      = dbi:mysql:database=mydb;host=localhost;port=1234
+username = user
+password = s3k r3t
+
+# another
+dsn      = dbi:mysql:database=mydb;host=remotehost;port=5678
+username = otheruser
+
+# sqlite
+dsn      = dbi:SQLite:db.sqlite
+
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..4aec937
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all =>
+    "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+my @drivers;
+my @modules
+    = grep { $_ ne 'Test::Database' }
+    grep { !/Driver::/ or push @drivers, $_ and 0 } all_modules();
+
+plan tests => @modules + @drivers + 1;
+
+# Test::Database exports are not documented
+pod_coverage_ok( 'Test::Database', { trustme => [qr/^test_db_\w+$/] } );
+
+# no exception for those modules
+pod_coverage_ok($_) for @modules;
+
+# the drivers methods are documented Test::Database::Driver
+pod_coverage_ok(
+    $_,
+    {   trustme => [
+            qr/^(?:(?:create|drop)_database|databases|dsn|is_filebased|cleanup|essentials)$/
+        ]
+    }
+) for @drivers;
+
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..ee8b18a
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();