~ubuntu-branches/ubuntu/precise/libdbd-firebird-perl/precise-updates

« back to all changes in this revision

Viewing changes to .pc/git/fix-tests-skipping.patch/t/dbi-rowcount.t

  • Committer: Bazaar Package Importer
  • Author(s): Damyan Ivanov
  • Date: 2011-09-27 23:27:43 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20110927232743-hyokctw5d6eajck2
Tags: 0.70-1
* New upstream release
 + documentation cleanup
 + support of Perl Unicode via ib_enable_utf8 attribute
 + fix $dbh->do() and $sth->execute() to properly return the number of
   affected records

* add a patch from upstream Git appending $Config{ccflags} to CCFLAGS
  (Closes: #643038 -- FTBFS with perl 5.14: CCFLAGS should include
  $Config{ccflags})
* add -classic alternatives to firebird server B-D
* add a patch from upstream fixing skipping of tests
* add libtest-exception-perl to B-D

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#/usr/bin/perl
 
2
 
 
3
# dbi-rowcount.t
 
4
#
 
5
# Verify behavior of interfaces which report number of rows affected
 
6
 
 
7
use strict;
 
8
use warnings;
 
9
use Test::More tests => 84;
 
10
use DBI;
 
11
use vars qw($dbh $table);
 
12
 
 
13
BEGIN {
 
14
        require 't/tests-setup.pl';
 
15
}
 
16
END {
 
17
       if (defined $dbh and defined $table) {
 
18
               eval { $dbh->do("DROP TABLE $table"); };
 
19
       }
 
20
}
 
21
 
 
22
# is() with special case "zero but true" support
 
23
sub is_maybe_zbt {
 
24
       my ($value, $expected) = @_;
 
25
       return ($value == $expected) unless $expected == 0;
 
26
 
 
27
       return (($value == 0 and $value));
 
28
}
 
29
 
 
30
# == Test Initialization =========================================
 
31
 
 
32
($dbh) = connect_to_database({RaiseError => 1});
 
33
pass("connect");
 
34
$table = find_new_table($dbh);
 
35
$dbh->do("CREATE TABLE $table(ID INTEGER NOT NULL, NAME VARCHAR(16) NOT NULL)");
 
36
pass("CREATE TABLE $table");
 
37
 
 
38
my @TEST_PROGRAM = (
 
39
       {
 
40
               sql      => qq|INSERT INTO $table (ID, NAME) VALUES (1, 'unu')|,
 
41
               desc     => 'literal insert',
 
42
               expected => 1,
 
43
       },
 
44
       {
 
45
               sql      => qq|INSERT INTO $table (ID, NAME) VALUES (?, ?)|,
 
46
               desc     => 'parameterized insert',
 
47
               params   => [2, 'du'],
 
48
               expected => 1,
 
49
       },
 
50
       {
 
51
               sql      => qq|DELETE FROM $table WHERE 1=0|,
 
52
               desc     => 'DELETE WHERE (false)',
 
53
               expected => 0,
 
54
       },
 
55
       {
 
56
               sql      => qq|UPDATE $table SET NAME='nomo'|,
 
57
               desc     => 'UPDATE all',
 
58
               expected => 2,
 
59
       },
 
60
       {
 
61
               sql      => qq|DELETE FROM $table|,
 
62
               desc     => 'DELETE all',
 
63
               expected => 2,
 
64
       },
 
65
);
 
66
 
 
67
# == Tests ==
 
68
 
 
69
# == 1. do()
 
70
 
 
71
for my $spec (@TEST_PROGRAM) {
 
72
       my @bind = @{$spec->{params}} if $spec->{params};
 
73
       my $rv = $dbh->do($spec->{sql}, undef, @bind);
 
74
 
 
75
       ok(is_maybe_zbt($rv, $spec->{expected}), "do($spec->{desc})");
 
76
       # $DBI::rows is not guaranteed to be correct after $dbh->blah operations
 
77
}
 
78
 
 
79
# == 2a. single execute() and rows()
 
80
 
 
81
for my $spec (@TEST_PROGRAM) {
 
82
       my @bind = @{$spec->{params}} if $spec->{params};
 
83
       my $sth = $dbh->prepare($spec->{sql});
 
84
       my $rv = $sth->execute(@bind);
 
85
 
 
86
       ok(is_maybe_zbt($rv, $spec->{expected}), "execute($spec->{desc})");
 
87
       is($DBI::rows, $spec->{expected}, "execute($spec->{desc}) (\$DBI::rows)");
 
88
       is($sth->rows, $spec->{expected}, "\$sth->rows($spec->{desc})");
 
89
}
 
90
 
 
91
# == 2b. repeated execute() and rows()
 
92
{
 
93
    my $i   = 0;
 
94
    my $sth = $dbh->prepare("INSERT INTO $table(ID, NAME) VALUES (?, ?)");
 
95
    for my $name (qw|unu du tri kvar kvin ses sep ok naux dek|) {
 
96
        my $rv = $sth->execute( ++$i, $name );
 
97
        is( $rv, 1, "re-execute(INSERT one) -> 1" );
 
98
        is( $DBI::rows, 1, "re-execute(INSERT one) -> 1 (\$DBI::rows)" );
 
99
        is( $sth->rows, 1, "\$sth->rows(re-executed INSERT)" );
 
100
    }
 
101
 
 
102
    $sth = $dbh->prepare("DELETE FROM $table WHERE ID<?");
 
103
    for ( 6, 11 ) {
 
104
        my $rv = $sth->execute($_);
 
105
        is( $rv,        5, "re-execute(DELETE five) -> 1" );
 
106
        is( $DBI::rows, 5, "re-execute(DELETE five) -> 1 (\$DBI::rows)" );
 
107
        is( $sth->rows, 5, "\$sth->rows(re-executed DELETE)" );
 
108
    }
 
109
    my $rv = $sth->execute(16);
 
110
    ok( is_maybe_zbt( $rv, 0 ), "re-execute(DELETE on empty) zero but true" );
 
111
    is( $DBI::rows, 0,
 
112
        "re-execute(DELETE on empty) (\$DBI::rows) zero but true" );
 
113
    is( $sth->rows, 0,
 
114
        "\$sth->rows(re-executed DELETE on empty) zero but true" );
 
115
}
 
116
 
 
117
# == 3. special cases
 
118
#       DBD::InterBase tracks the number of FETCHes on a SELECT statement
 
119
#       in $sth->rows() as an extension to the DBI.
 
120
 
 
121
{
 
122
    my $i = 0;
 
123
    for my $name (qw|unu du tri kvar kvin ses sep ok naux dek|) {
 
124
        $dbh->do( "INSERT INTO $table(ID, NAME) VALUES (?, ?)",
 
125
            undef, ++$i, $name );
 
126
    }
 
127
    my $sth = $dbh->prepare("SELECT ID, NAME FROM $table");
 
128
    my $rv  = $sth->execute;
 
129
    ok( is_maybe_zbt( $rv, 0 ), "execute(SELECT) -> zero but true" );
 
130
    is( $DBI::rows, 0, "execute(SELECT) zero but true (\$DBI::rows)" );
 
131
    is( $sth->rows, 0, "\$sth->rows(SELECT) zero but true" );
 
132
 
 
133
    my $fetched = 0;
 
134
    while ( $sth->fetch ) {
 
135
        is( ++$fetched, $sth->rows, "\$sth->rows incrementing on SELECT" );
 
136
        is( $fetched,   $DBI::rows, "\$DBI::rows incrementing on SELECT" );
 
137
    }
 
138
}