From 8bd54f9930a05126636129f1b694909dce5cd22a Mon Sep 17 00:00:00 2001 From: Adam Kennedy Date: Sun, 5 Apr 2009 18:55:08 +0000 Subject: [PATCH] Resolved #32889: prepare_cached does not work correctly Also resolved a few other minor things. --- Changes | 3 + lib/DBD/SQLite.pm | 4 + t/12_unicode.t | 17 +-- t/rt_25460_numeric_aggregate.t | 61 +++++++++ t/rt_32889_prepare_cached_reexecute.t | 177 ++++++++++++++++++++++++++ 5 files changed, 252 insertions(+), 10 deletions(-) create mode 100644 t/rt_25460_numeric_aggregate.t create mode 100644 t/rt_32889_prepare_cached_reexecute.t diff --git a/Changes b/Changes index 3cf4bb0..f87bf96 100644 --- a/Changes +++ b/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 diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index 519d725..bc8902b 100644 --- a/lib/DBD/SQLite.pm +++ b/lib/DBD/SQLite.pm @@ -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 diff --git a/t/12_unicode.t b/t/12_unicode.t index 1af5b64..dad5dd4 100644 --- a/t/12_unicode.t +++ b/t/12_unicode.t @@ -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"); diff --git a/t/rt_25460_numeric_aggregate.t b/t/rt_25460_numeric_aggregate.t new file mode 100644 index 0000000..4a4620f --- /dev/null +++ b/t/rt_25460_numeric_aggregate.t @@ -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' +); diff --git a/t/rt_32889_prepare_cached_reexecute.t b/t/rt_32889_prepare_cached_reexecute.t new file mode 100644 index 0000000..bf2575b --- /dev/null +++ b/t/rt_32889_prepare_cached_reexecute.t @@ -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' ); +}