mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 22:28:47 -04:00
Resolved #32889: prepare_cached does not work correctly
Also resolved a few other minor things.
This commit is contained in:
Adam Kennedy
parent
aa9335b2af
commit
8bd54f9930
5 changed files with 252 additions and 10 deletions
3
Changes
3
Changes
|
|
@ -5,6 +5,9 @@ Changes for Perl extension DBD-SQLite.
|
|||
- Resolved #29629: sqlite where length issue (actually this has
|
||||
been fixed before) (ISHIGAKI)
|
||||
- Applied an enable_load_extension patch from RT #32998 (ISHIGAKI)
|
||||
- Resolved #42940: DBD-SQLite make test faild (ADAMK)
|
||||
- Resolved #26460: Sorting numeric values in aggregate functions (ADAMK)
|
||||
- Resolved #32889: prepare_cached does not work correctly (ADAMK)
|
||||
|
||||
1.19_09 Sun 5 Apr 2009
|
||||
- Require perl 5.6 because dependencies require it
|
||||
|
|
|
|||
|
|
@ -97,6 +97,10 @@ sub _get_version {
|
|||
return( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') );
|
||||
}
|
||||
|
||||
sub disconnect {
|
||||
$DB::single = 1;
|
||||
}
|
||||
|
||||
my %info = (
|
||||
17 => 'SQLite', # SQL_DBMS_NAME
|
||||
18 => \&_get_version, # SQL_DBMS_VER
|
||||
|
|
|
|||
|
|
@ -75,24 +75,21 @@ Cannot connect to database 'DBI:SQLite:dbname=foo', please check directory and
|
|||
permissions.
|
||||
MESSAGE
|
||||
|
||||
Test( (my $table = FindNewTable($dbh)), "FindNewTable")
|
||||
or DbiError($dbh->error, $dbh->errstr);
|
||||
eval { $dbh->do("DROP TABLE table1"); };
|
||||
|
||||
eval { $dbh->do("DROP TABLE $table"); };
|
||||
|
||||
$dbh->do("CREATE TABLE $table (a TEXT, b BLOB)");
|
||||
$dbh->do("CREATE TABLE table1 (a TEXT, b BLOB)");
|
||||
|
||||
# Sends $ain and $bin into TEXT resp. BLOB columns the database, then
|
||||
# reads them again and returns the result as a list ($aout, $bout).
|
||||
sub database_roundtrip {
|
||||
my ($ain, $bin) = @_;
|
||||
$dbh->do("DELETE FROM $table");
|
||||
my $sth = $dbh->prepare("INSERT INTO $table (a, b) VALUES (?, ?)");
|
||||
$dbh->do("DELETE FROM table1");
|
||||
my $sth = $dbh->prepare("INSERT INTO table1 (a, b) VALUES (?, ?)");
|
||||
$sth->bind_param(1, $ain, SQL_VARCHAR);
|
||||
$sth->bind_param(2, $bin, SQL_BLOB);
|
||||
$sth->execute();
|
||||
|
||||
$sth = $dbh->prepare("SELECT a, b FROM $table");
|
||||
$sth = $dbh->prepare("SELECT a, b FROM table1");
|
||||
$sth->execute();
|
||||
my @row = $sth->fetchrow_array;
|
||||
undef $sth;
|
||||
|
|
@ -118,11 +115,11 @@ Test($bytesback eq $bytestring, "Still no blob corruption");
|
|||
Test($textback eq $utfstring, "Same text");
|
||||
|
||||
my $lengths = $dbh->selectall_arrayref(
|
||||
"SELECT length(a), length(b) FROM $table"
|
||||
"SELECT length(a), length(b) FROM table1"
|
||||
);
|
||||
|
||||
Test($lengths->[0]->[0] == $lengths->[0]->[1],
|
||||
"Database actually understands char set") or
|
||||
warn "($lengths->[0]->[0] != $lengths->[0]->[1])";
|
||||
|
||||
$dbh->do("DROP TABLE $table");
|
||||
$dbh->do("DROP TABLE table1");
|
||||
|
|
|
|||
61
t/rt_25460_numeric_aggregate.t
Normal file
61
t/rt_25460_numeric_aggregate.t
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 13;
|
||||
use t::lib::Test;
|
||||
|
||||
# Create the table
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
create table foo (
|
||||
id integer primary key not null,
|
||||
mygroup varchar(255) not null,
|
||||
mynumber numeric(20,3) not null
|
||||
)
|
||||
END_SQL
|
||||
|
||||
# Fill the table
|
||||
my @data = qw{
|
||||
a -2
|
||||
a 1
|
||||
b 2
|
||||
b 1
|
||||
c 3
|
||||
c -1
|
||||
d 4
|
||||
d 5
|
||||
e 6
|
||||
e 7
|
||||
};
|
||||
$dbh->begin_work;
|
||||
while ( @data ) {
|
||||
ok $dbh->do(
|
||||
'insert into foo ( mygroup, mynumber ) values ( ?, ? )', {},
|
||||
shift(@data), shift(@data),
|
||||
);
|
||||
}
|
||||
$dbh->commit;
|
||||
|
||||
# Issue the group/sum/sort/limit query
|
||||
my $rv = $dbh->selectall_arrayref(<<'END_SQL');
|
||||
select mygroup, sum(mynumber) as total
|
||||
from foo
|
||||
group by mygroup
|
||||
order by total
|
||||
limit 3
|
||||
END_SQL
|
||||
|
||||
is_deeply(
|
||||
$rv,
|
||||
[
|
||||
[ 'a', -1 ],
|
||||
[ 'c', 2 ],
|
||||
[ 'b', 3 ],
|
||||
],
|
||||
'group/sum/sort/limit query ok'
|
||||
);
|
||||
177
t/rt_32889_prepare_cached_reexecute.t
Normal file
177
t/rt_32889_prepare_cached_reexecute.t
Normal file
|
|
@ -0,0 +1,177 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# Tests that executing the same prepare_cached twice without a
|
||||
# finish in between does not prevent it being automatically cleaned
|
||||
# up and that it does not generate a warning.
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use Test::More tests => 31;
|
||||
use t::lib::Test;
|
||||
|
||||
# Create the table
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
ok( $dbh->do(<<'END_SQL'), 'CREATE TABLE' );
|
||||
create table foo (
|
||||
id integer primary key not null
|
||||
)
|
||||
END_SQL
|
||||
$dbh->begin_work;
|
||||
ok( $dbh->do('insert into foo values ( 1 )'), 'insert 1' );
|
||||
ok( $dbh->do('insert into foo values ( 2 )'), 'insert 2' );
|
||||
$dbh->commit;
|
||||
$dbh->disconnect;
|
||||
}
|
||||
|
||||
# Collect the warnings
|
||||
my $c = 0;
|
||||
my @w = ();
|
||||
$SIG{__WARN__} = sub { $c++; push @w, [ @_ ]; return };
|
||||
|
||||
# Conveniences
|
||||
my $sql = 'select * from foo order by id';
|
||||
|
||||
sub fetchrow_1 {
|
||||
my $row = $_[0]->fetchrow_arrayref;
|
||||
is_deeply( $row, [ 1 ], 'Got row 1' );
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
######################################################################
|
||||
# A well-behaved non-cached statement
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare($sql);
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 0, 'No warnings' );
|
||||
}
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare($sql);
|
||||
$sth->execute;
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 0, 'No warnings' );
|
||||
}
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 0, 'No warnings' );
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
######################################################################
|
||||
# A badly-behaved regular statement
|
||||
|
||||
# Double execute, no warnings
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 0, 'No warnings' );
|
||||
}
|
||||
|
||||
# We expect a warnings from this one
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
my $sth = $dbh->prepare($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$dbh->disconnect;
|
||||
is( $c, 1, 'Got a warning' );
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
######################################################################
|
||||
# A well-behaved cached statement
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 1, 'No warnings' );
|
||||
}
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$sth->finish;
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 1, 'No warnings' );
|
||||
}
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$sth->finish;
|
||||
}
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$sth->finish;
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 1, 'No warnings' );
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Badly-behaved prepare_cached (but still acceptable)
|
||||
|
||||
SCOPE: {
|
||||
my $dbh = connect_ok();
|
||||
SCOPE: {
|
||||
my $sth = $dbh->prepare_cached($sql);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$sth->execute;
|
||||
fetchrow_1($sth);
|
||||
$sth->finish;
|
||||
}
|
||||
$dbh->disconnect;
|
||||
is( $c, 1, 'No warnings' );
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue