File: 25-sql.t

package info (click to toggle)
libtest-database-perl 1.112-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 272 kB
  • ctags: 83
  • sloc: perl: 637; makefile: 2
file content (93 lines) | stat: -rw-r--r-- 2,610 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
use strict;
use warnings;
use Test::More;
use File::Spec;

use Test::Database;

my @drivers = Test::Database->drivers();
@drivers = grep {
    my $name = $_->name();
    grep { $name eq $_ } @ARGV
} @drivers if @ARGV;

# DBD::DBM uses SQL::Statement if available
# but SQL::Statement versions > 1.20 make the test fail
# (see RT #56463, #56561)
if (eval {
        require SQL::Statement;
        diag "SQL::Statement $SQL::Statement::VERSION";
        $SQL::Statement::VERSION > 1.20;
    }
    )
{
    my $skip_DBM = 0;
    @drivers = grep { !( $_->name() eq 'DBM' and $skip_DBM = 1 ) } @drivers;
    diag "skipping DBM tests because of SQL::Statement bug"
        if $skip_DBM;
}

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" );
}