# tdbcsqlite3.test -- # # Tests for the tdbc::sqlite3 bridge # # Copyright (c) 2008 by Kevin B. Kenny # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: tdbcsqlite3.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $ # #------------------------------------------------------------------------------ lappend auto_path . if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } loadTestedCommands package require tdbc::sqlite3 if {[info exists ::env(TDBCSQLITE3_TEST_DIR)]} { set testDirName $::env(TDBCSQLITE3_TEST_DIR) } else { set testDirName tdbctest } if {[info exists ::env(TDBCSQLITE3_TEST_DB)]} { set testFileName $::env(TDBCSQLITE3_TEST_DB) } else { set testFileName test.db } set testdir [makeDirectory $testDirName] set testDBName [makeFile {} $testFileName $testdir] catch {file delete -force $testDBName} #------------------------------------------------------------------------------- test tdbc::sqlite3-1.1 {create a connection, wrong # args} {*}{ -body { tdbc::sqlite3::connection create } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-1.2 {create a connection, connection string missing} {*}{ -body { tdbc::sqlite3::connection create db } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-1.3 {create a connection, failure} {*}{ -body { set status [catch { tdbc::sqlite3::connection create db /dev/null/wtf } result] list $status $result } -cleanup {catch {rename db {}}} -match glob -result {1 {unable to open database file}} } test tdbc::sqlite3-1.4 {create a connection, successful} {*}{ -body { tdbc::sqlite3::connection create ::db $::testDBName } -result ::db -cleanup { catch {rename ::db {}} } } #------------------------------------------------------------------------------- # # The tests that follow all require a connection to a database. tdbc::sqlite3::connection create ::db $::testDBName #------------------------------------------------------------------------------- test tdbc::sqlite3-2.1 {prepare statement, wrong # args} {*}{ -body { ::db prepare } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-2.2 {don't make a statement without a connection} {*}{ -body { tdbc::sqlite3::statement create stmt rubbish moreRubbish } -returnCodes error -match glob -result {invalid command name*} } test tdbc::sqlite3-2.3 {don't make a statement without a connection} {*}{ -body { tdbc::sqlite3::statement create stmt oo::class moreRubbish } -returnCodes error -match glob -result {unknown method*} } test tdbc::sqlite3-3.0 {prepare a valid statement} {*}{ -body { set stmt [::db prepare { CREATE TABLE people( idnum INTEGER PRIMARY KEY, name VARCHAR(40) NOT NULL ) }] } -match glob -result *Stmt* -cleanup { catch [rename $stmt {}] } } test tdbc::sqlite3-3.1 {execute a valid statement with no results} {*}{ -body { set stmt [::db prepare { CREATE TABLE people( idnum INTEGER PRIMARY KEY, name VARCHAR(40) NOT NULL ) }] set rs [$stmt execute] list [expr {[$rs rowcount] <= 0}] [$rs columns] [$rs nextrow nothing] } -result {1 {} 0} -cleanup { catch { rename $rs {} rename $stmt {} set stmt [::db prepare { DROP TABLE people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-3.2 {result set: wrong # args} {*}{ -body { set stmt [::db prepare { CREATE TABLE people( idnum INTEGER PRIMARY KEY, name VARCHAR(40) NOT NULL ) }] $stmt execute with extra args } -returnCodes error -match glob -result {wrong # args*} -cleanup { catch [rename $stmt {}] } } test tdbc::sqlite3-3.3 {result set: trying to create against a non-object} {*}{ -body { tdbc::sqlite3::resultset create rs nothing } -returnCodes error -match glob -result {invalid command name*} } test tdbc::sqlite3-3.4 {result set: trying to create against a non-statement} {*}{ -body { tdbc::sqlite3::resultset create rs db } -returnCodes error -match glob -result {unknown method*} } #------------------------------------------------------------------------------- # # Following tests need a 'people' table in the database set stmt [::db prepare { CREATE TABLE people( idnum INTEGER PRIMARY KEY, name VARCHAR(40) NOT NULL, info INTEGER ) }] set rs [$stmt execute] rename $rs {} rename $stmt {} test tdbc::sqlite3-4.1 {execute an insert with no params} {*}{ -body { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(1, 'fred', 0) }] set rs [$stmt execute] list [$rs rowcount] [$rs columns] [$rs nextrow nothing] } -result {1 {} 0} -cleanup { catch { rename $rs {} rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.2 {execute an insert with variable parameters} {*}{ -body { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 set name fred set rs [$stmt execute] list [$rs rowcount] [$rs columns] [$rs nextrow nothing] } -result {1 {} 0} -cleanup { catch { rename $rs {} rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.3 {execute an insert with dictionary parameters} {*}{ -body { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set rs [$stmt execute {idnum 1 name fred}] list [$rs rowcount] [$rs columns] [$rs nextrow nothing] } -result {1 {} 0} -cleanup { catch { rename $rs {} rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.4 {bad dictionary} {*}{ -body { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 $stmt execute {idnum 1 name} } -returnCodes error -result {missing value to go with key} -cleanup { catch { rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.7 {missing parameter - nullable} {*}{ -setup { catch {unset info} set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, :info) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 $stmt paramtype info integer set stmt2 [::db prepare { SELECT name, info FROM people WHERE idnum = :idnum }] $stmt2 paramtype idnum integer } -body { set name "mr. gravel" set idnum 100 set rs [$stmt execute] rename $rs {} set rs [$stmt2 execute] $rs nextrow -as dicts row set row } -result {name {mr. gravel}} -cleanup { catch {rename $rs {}} catch { rename $stmt {} rename $stmt2 {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.8 {missing parameter in dictionary - nullable} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, :info) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 $stmt paramtype info integer set stmt2 [::db prepare { SELECT name, info FROM people WHERE idnum = :idnum }] $stmt2 paramtype idnum integer } -body { set rs [$stmt execute {name {gary granite} idnum 200}] rename $rs {} set rs [$stmt2 execute {idnum 200}] $rs nextrow -as dicts row set row } -result {name {gary granite}} -cleanup { catch {rename $rs {}} catch { rename $stmt {} rename $stmt2 {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.9 {two result sets open against the same statement} {*}{ -body { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set rs1 [$stmt execute {idnum 1 name fred}] set rs2 [$stmt execute {idnum 2 name wilma}] list [$rs1 rowcount] [$rs1 columns] [$rs1 nextrow nothing] \ [$rs2 rowcount] [$rs2 columns] [$rs2 nextrow nothing] } -result {1 {} 0 1 {} 0} -cleanup { catch { rename $rs1 {} rename $rs2 {} rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } } } test tdbc::sqlite3-4.10 {failed execution} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set rs [$stmt execute {idnum 1 name fred}] rename $rs {} } -body { catch {$stmt execute {idnum 1 name barney}} } -cleanup { rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } -result 1 } if 0 { # following tests check error syntax for 'paramtype' - and tdbcsqlite3 # ignores paramtype, so they're kind of meaningless test tdbc::sqlite3-5.1 {paramtype - too few args} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] } -body { $stmt paramtype idnum } -cleanup { rename $stmt {} } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-5.2 {paramtype - just a direction} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] } -body { $stmt paramtype idnum in } -cleanup { rename $stmt {} } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-5.3 {paramtype - bad type} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] } -body { $stmt paramtype idnum rubbish } -cleanup { rename $stmt {} } -returnCodes error -match glob -result {bad SQL data type "rubbish":*} } test tdbc::sqlite3-5.4 {paramtype - bad scale} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] } -body { $stmt paramtype idnum decimal rubbish } -cleanup { rename $stmt {} } -returnCodes error -match glob -result {expected integer but got "rubbish"} } test tdbc::sqlite3-5.5 {paramtype - bad precision} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] } -body { $stmt paramtype idnum decimal 12 rubbish } -cleanup { rename $stmt {} } -returnCodes error -match glob -result {expected integer but got "rubbish"} } test tdbc::sqlite3-5.6 {paramtype - unknown parameter} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] } -body { $stmt paramtype rubbish integer } -cleanup { rename $stmt {} } -returnCodes error -match glob -result {unknown parameter "rubbish":*} } } test tdbc::sqlite3-6.1 {rowcount - wrong args} {*}{ -setup { set stmt [::db prepare { INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set rs [$stmt execute {idnum 1 name fred}] } -body { $rs rowcount rubbish } -cleanup { rename $rs {} rename $stmt {} set stmt [::db prepare { DELETE FROM people }] set rs [$stmt execute] rename $rs {} rename $stmt {} } -returnCodes error -match glob -result "wrong \# args*" } #------------------------------------------------------------------------------- # # next tests require data in the database catch { set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } #------------------------------------------------------------------------------- test tdbc::sqlite3-7.1 {columns - bad args} {*}{ -setup { set stmt [::db prepare { SELECT * FROM people }] set rs [$stmt execute] } -body { $rs columns rubbish } -cleanup { rename $rs {} rename $stmt {} } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-7.2 {columns - get column names} {*}{ -setup { set stmt [::db prepare { SELECT * FROM people }] set rs [$stmt execute] } -body { $rs columns } -cleanup { rename $rs {} rename $stmt {} } -result {idnum name info} } test tdbc::sqlite3-8.1 {nextrow - as dicts} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people ORDER BY idnum }] set rs [$stmt execute] } -body { set idnum 1 set names {} while {[$rs nextrow -- row]} { if {$idnum != [dict get $row idnum]} { error [list bad idnum [dict get $row idnum] should be $idnum] } lappend names [dict get $row name] incr idnum } set names } -cleanup { rename $rs {} rename $stmt {} } -result {fred wilma pebbles barney betty bam-bam} } test tdbc::sqlite3-8.2 {nextrow - as lists} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people ORDER BY idnum }] set rs [$stmt execute] } -body { set idnum 1 set names {} while {[$rs nextrow -as lists -- row]} { if {$idnum != [lindex $row 0]} { error [list bad idnum [lindex $row 0] should be $idnum] } lappend names [lindex $row 1] incr idnum } set names } -cleanup { rename $rs {} rename $stmt {} } -result {fred wilma pebbles barney betty bam-bam} } test tdbc::sqlite3-8.3 {nextrow - bad cursor state} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people ORDER BY idnum }] } -body { set rs [$stmt execute] set names {} while {[$rs nextrow row]} {} $rs nextrow row } -cleanup { rename $rs {} rename $stmt {} } -result 0 } test tdbc::sqlite3-8.4 {anonymous columns - dicts} {*}{ -setup { set stmt [::db prepare { SELECT COUNT(*), MAX(idnum) FROM people }] set rs [$stmt execute] } -body { list \ [$rs nextrow row] \ $row \ [$rs nextrow row] } -cleanup { $stmt close } -match glob -result {1 {* 6 * 6} 0} }; test tdbc::sqlite3-8.5 {anonymous columns - lists} {*}{ -setup { set stmt [::db prepare { SELECT COUNT(*), MAX(idnum) FROM people }] set rs [$stmt execute] } -body { list [$rs nextrow -as lists row] \ $row \ [$rs nextrow -as lists row] } -cleanup { $stmt close } -result {1 {6 6} 0} }; test tdbc::sqlite3-8.6 {null results - dicts} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name = 'fred' }] set rs [$stmt execute] } -body { list [$rs nextrow row] $row [$rs nextrow row] } -cleanup { $stmt close } -result {1 {idnum 1 name fred} 0} } test tdbc::sqlite3-8.7 {null results - lists} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name = 'fred' }] set rs [$stmt execute] } -body { list [$rs nextrow -as lists -- row] $row [$rs nextrow -as lists -- row] } -cleanup { $stmt close } -result {1 {1 fred {}} 0} } test tdbc::sqlite3-9.1 {rs foreach var script} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach row { lappend result $row } set result } -cleanup { $rs close $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.2 {stmt foreach var script} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach row { lappend result $row } set result } -cleanup { $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.3 {db foreach var sqlcode script} {*}{ -body { set result {} db foreach row { SELECT idnum, name FROM people WHERE name LIKE 'b%' } { lappend result $row } set result } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.4 {rs foreach -- var script} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach -- row { lappend result $row } set result } -cleanup { $rs close $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.5 {stmt foreach -- var script} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach -- row { lappend result $row } set result } -cleanup { $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.6 {db foreach -- var query script} {*}{ -body { set result {} db foreach -- row { SELECT idnum, name FROM people WHERE name LIKE 'b%' } { lappend result $row } set result } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.7 {rs foreach -- -as lists} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach -as lists row { lappend result $row } set result } -cleanup { $rs close $stmt close } -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.8 {stmt foreach -as lists} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach -as lists row { lappend result $row } set result } -cleanup { $stmt close } -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.9 {db foreach -as lists} {*}{ -body { set result {} db foreach -as lists row { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' } { lappend result $row } set result } -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.10 {rs foreach -as lists --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach -as lists -- row { lappend result $row } set result } -cleanup { $rs close $stmt close } -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.11 {stmt foreach -as lists --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach -as lists -- row { lappend result $row } set result } -cleanup { $stmt close } -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.12 {db foreach -as lists --} {*}{ -body { set result {} db foreach -as lists row { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' } { lappend result $row } set result } -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.13 {rs foreach -as lists -columnsvar c --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach -as lists -columnsvar c -- row { foreach cn $c cv $row { lappend result $cn $cv } } set result } -cleanup { $rs close $stmt close } -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam} } test tdbc::sqlite3-9.14 {stmt foreach -as lists -columnsvar c --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach -as lists -columnsvar c -- row { foreach cn $c cv $row { lappend result $cn $cv } } set result } -cleanup { $stmt close } -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam} } test tdbc::sqlite3-9.15 {db foreach -as lists -columnsvar c --} {*}{ -body { set result {} db foreach -as lists -columnsvar c -- row { SELECT idnum, name FROM people WHERE name LIKE 'b%' } { foreach cn $c cv $row { lappend result $cn $cv } } set result } -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam} } test tdbc::sqlite3-9.16 {rs foreach / break out of loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach -as lists -- row { if {[lindex $row 1] eq {betty}} break lappend result $row } set result } -cleanup { $rs close $stmt close } -result {{4 barney {}}} } test tdbc::sqlite3-9.17 {stmt foreach / break out of loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach -as lists -- row { if {[lindex $row 1] eq {betty}} break lappend result $row } set result } -cleanup { $stmt close } -result {{4 barney {}}} } test tdbc::sqlite3-9.18 {db foreach / break out of loop} {*}{ -body { set result {} db foreach -as lists -- row { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' } { if {[lindex $row 1] eq {betty}} break lappend result $row } set result } -result {{4 barney {}}} } test tdbc::sqlite3-9.19 {rs foreach / continue in loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result {} $rs foreach -as lists -- row { if {[lindex $row 1] eq {betty}} continue lappend result $row } set result } -cleanup { $rs close $stmt close } -result {{4 barney {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.20 {stmt foreach / continue in loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' }] } -body { set result {} $stmt foreach -as lists -- row { if {[lindex $row 1] eq {betty}} continue lappend result $row } set result } -cleanup { $stmt close } -result {{4 barney {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.21 {db foreach / continue in loop} {*}{ -body { set result {} db foreach -as lists -- row { SELECT idnum, name, info FROM people WHERE name LIKE 'b%' } { if {[lindex $row 1] eq {betty}} continue lappend result $row } set result } -result {{4 barney {}} {6 bam-bam {}}} } test tdbc::sqlite3-9.22 {rs foreach / return out of the loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] proc tdbc::sqlite3-9.22 {rs} { $rs foreach -as lists -- row { if {[lindex $row 1] eq {betty}} { return [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.22 $rs } -cleanup { rename tdbc::sqlite3-9.22 {} rename $rs {} rename $stmt {} } -result 5 } test tdbc::sqlite3-9.23 {stmt foreach / return out of the loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] proc tdbc::sqlite3-9.23 {stmt} { $stmt foreach -as lists -- row { if {[lindex $row 1] eq {betty}} { return [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.23 $stmt } -cleanup { rename tdbc::sqlite3-9.23 {} rename $stmt {} } -result 5 } test tdbc::sqlite3-9.24 {db foreach / return out of the loop} {*}{ -setup { proc tdbc::sqlite3-9.24 {stmt} { db foreach -as lists -- row { SELECT idnum, name FROM people WHERE name LIKE 'b%' } { if {[lindex $row 1] eq {betty}} { return [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.24 $stmt } -cleanup { rename tdbc::sqlite3-9.24 {} } -result 5 } test tdbc::sqlite3-9.25 {rs foreach / error out of the loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] proc tdbc::sqlite3-9.25 {rs} { $rs foreach -as lists -- row { if {[lindex $row 1] eq {betty}} { error [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.25 $rs } -cleanup { rename tdbc::sqlite3-9.25 {} rename $rs {} rename $stmt {} } -returnCodes error -result 5 } test tdbc::sqlite3-9.26 {stmt foreach - error out of the loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] proc tdbc::sqlite3-9.26 {stmt} { $stmt foreach -as lists -- row { if {[lindex $row 1] eq {betty}} { error [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.26 $stmt } -cleanup { rename tdbc::sqlite3-9.26 {} rename $stmt {} } -returnCodes error -result 5 } test tdbc::sqlite3-9.27 {db foreach / error out of the loop} {*}{ -setup { proc tdbc::sqlite3-9.27 {} { db foreach -as lists -- row { SELECT idnum, name FROM people WHERE name LIKE 'b%' } { if {[lindex $row 1] eq {betty}} { error [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.27 } -cleanup { rename tdbc::sqlite3-9.27 {} } -returnCodes error -result 5 } test tdbc::sqlite3-9.28 {rs foreach / unknown status from the loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] proc tdbc::sqlite3-9.28 {rs} { $rs foreach -as lists -- row { if {[lindex $row 1] eq {betty}} { return -code 666 -level 0 [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.28 $rs } -cleanup { rename tdbc::sqlite3-9.28 {} rename $rs {} rename $stmt {} } -returnCodes 666 -result 5 } test tdbc::sqlite3-9.29 {stmt foreach / unknown status from the loop} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] proc tdbc::sqlite3-9.29 {stmt} { $stmt foreach -as lists -- row { if {[lindex $row 1] eq {betty}} { return -code 666 -level 0 [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.29 $stmt } -cleanup { rename tdbc::sqlite3-9.29 {} rename $stmt {} } -returnCodes 666 -result 5 } test tdbc::sqlite3-9.30 {db foreach / unknown status from the loop} {*}{ -setup { proc tdbc::sqlite3-9.30 {stmt} { db foreach -as lists -- row { SELECT idnum, name FROM people WHERE name LIKE 'b%' } { if {[lindex $row 1] eq {betty}} { return -code 666 -level 0 [lindex $row 0] } } return failed } } -body { tdbc::sqlite3-9.30 $stmt } -cleanup { rename tdbc::sqlite3-9.30 {} } -returnCodes 666 -result 5 } test tdbc::sqlite3-9.31 {stmt foreach / params in variables} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE :thePattern }] $stmt paramtype thePattern varchar 40 } -body { set result {} set thePattern b% $stmt foreach row { lappend result $row } set result } -cleanup { $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.32 {db foreach / params in variables} {*}{ -body { set result {} set thePattern b% db foreach row { SELECT idnum, name FROM people WHERE name LIKE :thePattern } { lappend result $row } set result } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.33 {stmt foreach / parameters in a dictionary} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE :thePattern }] $stmt paramtype thePattern varchar 40 } -body { set result {} $stmt foreach row {thePattern b%} { lappend result $row } set result } -cleanup { $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.34 {db foreach / parameters in a dictionary} {*}{ -body { set result {} db foreach row { SELECT idnum, name FROM people WHERE name LIKE :thePattern } {thePattern b%} { lappend result $row } set result } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-9.35 {stmt foreach - variable not found} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE :thePattern }] $stmt paramtype thePattern varchar 40 catch {unset thePattern} } -body { set result {} set thePattern(bogosity) {} $stmt foreach row { lappend result $row } set result } -cleanup { unset thePattern $stmt close } -result {} } test tdbc::sqlite3-9.36 {db foreach - variable not found} {*}{ -setup { catch {unset thePattern} } -body { set result {} set thePattern(bogosity) {} db foreach row { SELECT idnum, name FROM people WHERE name LIKE :thePattern } { lappend result $row } set result } -cleanup { unset thePattern } -result {} } test tdbc::sqlite3-9.37 {rs foreach - too few args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people }] set rs [$stmt execute] } -body { $rs foreach row } -cleanup { $rs close $stmt close } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-9.38 {stmt foreach - too few args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people }] } -body { $stmt foreach row } -cleanup { $stmt close } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-9.39 {db foreach - too few args} {*}{ -body { db foreach row { SELECT idnum, name FROM people } } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-9.40 {rs foreach - too many args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people }] set rs [$stmt execute] } -body { $rs foreach row do something } -cleanup { $rs close $stmt close } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-9.41 {stmt foreach - too many args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people }] } -body { $stmt foreach row do something else } -cleanup { $stmt close } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-9.42 {db foreach - too many args} {*}{ -body { db foreach row { SELECT idnum, name FROM people } {} do something } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-10.1 {allrows - no args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { $rs allrows } -cleanup { rename $rs {} rename $stmt {} } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.2 {allrows - no args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { $stmt allrows } -cleanup { rename $stmt {} } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.3 {allrows - no args} {*}{ -body { db allrows { SELECT idnum, name FROM people WHERE name LIKE 'b%' } } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.4 {allrows --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { $rs allrows -- } -cleanup { rename $rs {} rename $stmt {} } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.5 {allrows --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { $stmt allrows -- } -cleanup { rename $stmt {} } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.6 {allrows --} {*}{ -body { db allrows -- { SELECT idnum, name FROM people WHERE name LIKE 'b%' } } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.7 {allrows -as lists} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { $rs allrows -as lists } -cleanup { rename $rs {} rename $stmt {} } -result {{4 barney} {5 betty} {6 bam-bam}} } test tdbc::sqlite3-10.8 {allrows -as lists} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { $stmt allrows -as lists } -cleanup { rename $stmt {} } -result {{4 barney} {5 betty} {6 bam-bam}} } test tdbc::sqlite3-10.9 {allrows -as lists} {*}{ -body { db allrows -as lists { SELECT idnum, name FROM people WHERE name LIKE 'b%' } } -result {{4 barney} {5 betty} {6 bam-bam}} } test tdbc::sqlite3-10.10 {allrows -as lists --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { $rs allrows -as lists -- } -cleanup { rename $rs {} rename $stmt {} } -result {{4 barney} {5 betty} {6 bam-bam}} } test tdbc::sqlite3-10.11 {allrows -as lists --} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { $stmt allrows -as lists -- } -cleanup { rename $stmt {} } -result {{4 barney} {5 betty} {6 bam-bam}} } test tdbc::sqlite3-10.12 {allrows -as lists --} {*}{ -body { db allrows -as lists -- { SELECT idnum, name FROM people WHERE name LIKE 'b%' } } -result {{4 barney} {5 betty} {6 bam-bam}} } test tdbc::sqlite3-10.13 {allrows -as lists -columnsvar c} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] set rs [$stmt execute] } -body { set result [$rs allrows -as lists -columnsvar c] list $c $result } -cleanup { rename $rs {} rename $stmt {} } -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}} } test tdbc::sqlite3-10.14 {allrows -as lists -columnsvar c} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] } -body { set result [$stmt allrows -as lists -columnsvar c] list $c $result } -cleanup { rename $stmt {} } -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}} } test tdbc::sqlite3-10.15 {allrows -as lists -columnsvar c} {*}{ -body { set result [db allrows -as lists -columnsvar c { SELECT idnum, name FROM people WHERE name LIKE 'b%' }] list $c $result } -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}} } test tdbc::sqlite3-10.16 {allrows - correct lexical scoping of variables} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE :thePattern }] $stmt paramtype thePattern varchar 40 } -body { set thePattern b% $stmt allrows } -cleanup { $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.17 {allrows - parameters in a dictionary} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people WHERE name LIKE :thePattern }] $stmt paramtype thePattern varchar 40 } -body { $stmt allrows {thePattern b%} } -cleanup { $stmt close } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.18 {allrows - parameters in a dictionary} {*}{ -body { db allrows { SELECT idnum, name FROM people WHERE name LIKE :thePattern } {thePattern b%} } -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} } test tdbc::sqlite3-10.19 {allrows - variable not found} {*}{ -setup { catch {unset thePattern} } -body { set thePattern(bogosity) {} db allrows { SELECT idnum, name FROM people WHERE name LIKE :thePattern } } -cleanup { unset thePattern } -result {} } test tdbc::sqlite3-10.20 {allrows - too many args} {*}{ -setup { set stmt [::db prepare { SELECT idnum, name FROM people }] } -body { $stmt allrows {} rubbish } -cleanup { $stmt close } -returnCodes error -result {wrong # args*} -match glob } test tdbc::sqlite3-10.21 {bad -as} {*}{ -body { db allrows -as trash { SELECT idnum, name FROM people } } -returnCodes error -result {bad variable type "trash": must be lists or dicts} } test tdbc::sqlite3-11.1 {update - no rows} {*}{ -setup { set stmt [::db prepare { UPDATE people SET info = 1 WHERE idnum > 6 }] set rs [$stmt execute] } -body { $rs rowcount } -cleanup { rename $rs {} rename $stmt {} } -result 0 } test tdbc::sqlite3-11.2 {update - unique row} {*}{ -setup { set stmt [::db prepare { UPDATE people SET info = 1 WHERE name = 'fred' }] } -body { set rs [$stmt execute] $rs rowcount } -cleanup { rename $rs {} rename $stmt {} } -result 1 } test tdbc::sqlite3-11.3 {update - multiple rows} {*}{ -setup { set stmt [::db prepare { UPDATE people SET info = 1 WHERE name LIKE 'b%' }] } -body { set rs [$stmt execute] $rs rowcount } -cleanup { rename $rs {} rename $stmt {} } -result 3 } test tdbc::sqlite3-12.1 {delete - no rows} {*}{ -setup { set stmt [::db prepare { DELETE FROM people WHERE name = 'nobody' }] } -body { set rs [$stmt execute] $rs rowcount } -cleanup { rename $rs {} rename $stmt {} } -result 0 } test tdbc::sqlite3-12.2 {delete - unique row} {*}{ -setup { set stmt [::db prepare { DELETE FROM people WHERE name = 'fred' }] } -body { set rs [$stmt execute] $rs rowcount } -cleanup { rename $rs {} rename $stmt {} } -result 1 } test tdbc::sqlite3-12.3 {delete - multiple rows} {*}{ -setup { set stmt [::db prepare { DELETE FROM people WHERE name LIKE 'b%' }] } -body { set rs [$stmt execute] $rs rowcount } -cleanup { rename $rs {} rename $stmt {} } -result 3 } test tdbc::sqlite3-13.1 {resultsets - no results} {*}{ -setup { set stmt [::db prepare { SELECT name FROM people WHERE idnum = $idnum }] } -body { list \ [llength [$stmt resultsets]] \ [llength [::db resultsets]] } -cleanup { rename $stmt {} } -result {0 0} } test tdbc::sqlite3-13.2 {resultsets - various statements and results} {*}{ -setup { for {set i 0} {$i < 6} {incr i} { set stmts($i) [::db prepare { SELECT name FROM people WHERE idnum = :idnum }] $stmts($i) paramtype idnum integer for {set j 0} {$j < $i} {incr j} { set resultsets($i,$j) [$stmts($i) execute [list idnum $j]] } for {set j 1} {$j < $i} {incr j 2} { $resultsets($i,$j) close unset resultsets($i,$j) } } } -body { set x [list [llength [::db resultsets]]] for {set i 0} {$i < 6} {incr i} { lappend x [llength [$stmts($i) resultsets]] } set x } -cleanup { for {set i 0} {$i < 6} {incr i} { $stmts($i) close } } -result {9 0 1 1 2 2 3} } # reset the database again catch { db allrows {DELETE FROM people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } test tdbc::sqlite3-13.3 {duplicate column names} {*}{ -constraints knownBug -body { ::db allrows -as dicts -- { select a.name, b.name, c.name from people a, people b, people c where a.idnum = 1 and b.idnum = a.idnum + 1 and c.idnum = a.idnum + 2 } } -result {{name fred name#2 wilma name#3 pebbles}} } test tdbc::sqlite3-13.4 {duplicate column names} {*}{ -constraints knownBug -body { ::db allrows -as dicts -- { select a.name, b.name, c.name as "name#2" from people a, people b, people c where a.idnum = 1 and b.idnum = a.idnum + 1 and c.idnum = a.idnum + 2 } } -result {{name fred name#2 wilma name#2#1 pebbles}} } test tdbc::sqlite3-13.5 {duplicate column names} {*}{ -constraints knownBug -body { ::db allrows -as dicts -- { select a.name, b.name as "name#2", c.name from people a, people b, people c where a.idnum = 1 and b.idnum = a.idnum + 1 and c.idnum = a.idnum + 2 } } -result {{name fred name#2 wilma name#2#1 pebbles}} } #------------------------------------------------------------------------------- # # next tests require a fresh database connection. Close the existing one down catch { set stmt [db prepare { DELETE FROM people }] $stmt execute } catch { rename ::db {} } tdbc::sqlite3::connection create ::db $::testDBName catch { set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } test tdbc::sqlite3-14.1 {begin transaction - wrong # args} {*}{ -body { ::db begintransaction junk } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-14.2 {commit - wrong # args} {*}{ -body { ::db commit junk } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-14.3 {rollback - wrong # args} {*}{ -body { ::db rollback junk } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-14.4 {commit - not in transaction} {*}{ -body { list [catch {::db commit} result] $result } -result {1 {cannot commit - no transaction is active}} } test tdbc::sqlite3-14.5 {rollback - not in transaction} {*}{ -body { list [catch {::db rollback} result] $result } -match glob -result {1 {cannot rollback - no transaction is active}} } test tdbc::sqlite3-14.6 {empty transaction} {*}{ -body { ::db begintransaction ::db commit } -result {} } test tdbc::sqlite3-14.7 {empty rolled-back transaction} {*}{ -body { ::db begintransaction ::db rollback } -result {} } test tdbc::sqlite3-14.8 {rollback does not change database} {*}{ -body { ::db begintransaction set stmt [::db prepare {DELETE FROM people WHERE name = 'fred'}] set rs [$stmt execute] while {[$rs nextrow trash]} {} rename $rs {} rename $stmt {} ::db rollback set stmt [::db prepare {SELECT idnum FROM people WHERE name = 'fred'}] set id {changes still visible after rollback} set rs [$stmt execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} rename $stmt {} set id } -result 1 } test tdbc::sqlite3-14.9 {commit does change database} {*}{ -setup { set stmt1 [db prepare { INSERT INTO people(idnum, name, info) VALUES(7, 'mr. gravel', 0) }] set stmt2 [db prepare { SELECT idnum FROM people WHERE name = 'mr. gravel' }] } -body { ::db begintransaction set rs [$stmt1 execute] rename $rs {} ::db commit set rs [$stmt2 execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} set id } -cleanup { rename $stmt1 {} rename $stmt2 {} } -result 7 } test tdbc::sqlite3-14.10 {nested transactions} {*}{ -body { ::db begintransaction list [catch {::db begintransaction} result] $result } -cleanup { catch {::db rollback} } -match glob -result {1 {cannot start a transaction within a transaction}} } #------------------------------------------------------------------------------ # # Clean up database again for the next round. catch { set stmt [db prepare { DELETE FROM people }] $stmt execute } catch { rename ::db {} } tdbc::sqlite3::connection create ::db $::testDBName catch { set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } test tdbc::sqlite3-15.1 {successful (empty) transaction} {*}{ -body { db transaction { concat ok } } -result ok } test tdbc::sqlite3-15.2 {failing transaction does not get committed} {*}{ -setup { set stmt1 [db prepare { DELETE FROM people WHERE name = 'fred' }] set stmt2 [db prepare { SELECT idnum FROM people WHERE name = 'fred' }] } -body { catch { ::db transaction { set rs [$stmt1 execute] rename $rs {} error "abort the transaction" } } result set id {failed transaction got committed} set rs [$stmt2 execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} list $result $id } -cleanup { rename $stmt1 {} rename $stmt2 {} } -result {{abort the transaction} 1} } test tdbc::sqlite3-15.3 {successful transaction gets committed} {*}{ -setup { set stmt1 [db prepare { INSERT INTO people(idnum, name, info) VALUES(7, 'mr. gravel', 0) }] set stmt2 [db prepare { SELECT idnum FROM people WHERE name = 'mr. gravel' }] } -body { ::db transaction { set rs [$stmt1 execute] rename $rs {} } set rs [$stmt2 execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} set id } -cleanup { rename $stmt1 {} rename $stmt2 {} } -result 7 } test tdbc::sqlite3-15.4 {break out of transaction commits it} {*}{ -setup { set stmt1 [db prepare { INSERT INTO people(idnum, name, info) VALUES(8, 'gary granite', 0) }] set stmt2 [db prepare { SELECT idnum FROM people WHERE name = 'gary granite' }] } -body { while {1} { ::db transaction { set rs [$stmt1 execute] rename $rs {} break } } set rs [$stmt2 execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} set id } -cleanup { rename $stmt1 {} rename $stmt2 {} } -result 8 } test tdbc::sqlite3-15.5 {continue in transaction commits it} {*}{ -setup { set stmt1 [db prepare { INSERT INTO people(idnum, name, info) VALUES(9, 'hud rockstone', 0) }] set stmt2 [db prepare { SELECT idnum FROM people WHERE name = 'hud rockstone' }] } -body { for {set i 0} {$i < 1} {incr i} { ::db transaction { set rs [$stmt1 execute] rename $rs {} continue } } set rs [$stmt2 execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} set id } -cleanup { rename $stmt1 {} rename $stmt2 {} } -result 9 } test tdbc::sqlite3-15.6 {return in transaction commits it} {*}{ -setup { set stmt1 [db prepare { INSERT INTO people(idnum, name, info) VALUES(10, 'nelson stoneyfeller', 0) }] set stmt2 [db prepare { SELECT idnum FROM people WHERE name = 'nelson stoneyfeller' }] proc tdbc::sqlite3-15.6 {stmt1} { ::db transaction { set rs [$stmt1 execute] rename $rs {} return } } } -body { tdbc::sqlite3-15.6 $stmt1 set rs [$stmt2 execute] while {[$rs nextrow -as lists row]} { set id [lindex $row 0] } rename $rs {} set id } -cleanup { rename $stmt1 {} rename $stmt2 {} rename tdbc::sqlite3-15.6 {} } -result 10 } test tdbc::sqlite3-16.1 {database tables, wrong # args} { -body { set dict [::db tables % rubbish] } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-16.2 {database tables - empty set} { -body { ::db tables q% } -result {} } test tdbc::sqlite3-16.3 {enumerate database tables} {*}{ -body { set dict [::db tables] list [dict exists $dict people] [dict exists $dict property] } -result {1 0} } test tdbc::sqlite3-16.4 {enumerate database tables} {*}{ -body { set dict [::db tables p%] list [dict exists $dict people] [dict exists $dict property] } -result {1 0} } test tdbc::sqlite3-17.1 {database columns - wrong # args} {*}{ -body { set dict [::db columns people % rubbish] } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-17.2 {database columns - no such table} {*}{ -body { ::db columns rubbish } -result {} } test tdbc::sqlite3-17.3 {database columns - no match pattern} {*}{ -body { set result {} dict for {colname attrs} [::db columns people] { lappend result $colname \ [dict get $attrs type] \ [expr {[dict exists $attrs precision] ? [dict get $attrs precision] : {NULL}}] \ [expr {[dict exists $attrs scale] ? [dict get $attrs scale] : {NULL}}] \ [dict get $attrs nullable] } set result } -match glob -result {idnum integer * 0 1 name varchar 40 * info integer * 0 1} } # sqlite driver appears not to implement pattern matching for SQLGetColumns test tdbc::sqlite3-17.4 {database columns - match pattern} {*}{ -body { set result {} dict for {colname attrs} [::db columns people i%] { lappend result $colname \ [dict get $attrs type] \ [expr {[dict exists $attrs precision] ? [dict get $attrs precision] : {NULL}}] \ [expr {[dict exists $attrs scale] ? [dict get $attrs scale] : {NULL}}] \ [dict get $attrs nullable] } set result } -result {idnum integer 0 0 1 info integer 0 0 1} } test tdbc::sqlite3-18.1 {$statement params - excess arg} {*}{ -setup { set s [::db prepare { SELECT name FROM people WHERE name LIKE :pattern AND idnum >= :minid }] $s paramtype minid numeric 10 0 $s paramtype pattern varchar 40 } -body { $s params excess } -cleanup { rename $s {} } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-18.2 {$statement params - no params} {*}{ -setup { set s [::db prepare { SELECT name FROM people }] } -body { $s params } -cleanup { rename $s {} } -result {} } test tdbc::sqlite3-18.3 {$statement params - excess arg} {*}{ -setup { set s [::db prepare { SELECT name FROM people WHERE name LIKE :pattern AND idnum >= :minid }] $s paramtype minid numeric 10 0 $s paramtype pattern varchar 40 } -body { set d [$s params] list \ [dict get $d minid direction] \ [dict get $d minid type] \ [dict get $d minid precision] \ [dict get $d minid scale] \ [dict get $d pattern direction] \ [dict get $d pattern type] \ [dict get $d pattern precision] } -cleanup { rename $s {} } -result {in Tcl_Obj 0 0 in Tcl_Obj 0} } test tdbc::sqlite3-19.1 {$connection configure - no args} \ -body { ::db configure } \ -match glob \ -result [list -encoding utf-8 \ -isolation serializable \ -keepcase 0 \ -readonly 0 \ -timeout 0] test tdbc::sqlite3-19.2 {$connection configure - unknown arg} {*}{ -body { ::db configure -junk } -returnCodes error -match glob -result "bad option *" } test tdbc::sqlite3-19.4 {$connection configure - set unknown arg} {*}{ -body { ::db configure -junk morejunk } -returnCodes error -match glob -result "bad option *" } test tdbc::sqlite3-19.6 {$connection configure - wrong # args} {*}{ -body { ::db configure -parent . -junk } -returnCodes error -match glob -result "wrong # args*" } test tdbc::sqlite3-19.7 {$connection configure - -encoding} {*}{ -body { ::db configure -encoding junk } -returnCodes error -match glob -result {-encoding not supported*} } test tdbc::sqlite3-19.9 {$connection configure - -encoding} \ -body { list [::db configure -encoding utf-8] \ [::db configure -encoding] } \ -result [list {} utf-8] test tdbc::sqlite3-19.10 {$connection configure - -isolation} {*}{ -body { ::db configure -isolation junk } -returnCodes error -match glob -result {bad isolation level "junk"*} } test tdbc::sqlite3-19.11 {$connection configure - -isolation} {*}{ -body { list [::db configure -isolation readuncommitted] \ [::db configure -isolation] \ [::db configure -isolation readcommitted] \ [::db configure -isolation] } -result {{} readuncommitted {} serializable} } test tdbc::sqlite3-19.12 {$connection configure - -readonly} {*}{ -body { ::db configure -readonly junk } -returnCodes error -result {expected boolean value but got "junk"} } test tdbc::sqlite3-19.14 {$connection configure - -timeout} {*}{ -body { ::db configure -timeout junk } -returnCodes error -result {expected integer but got "junk"} } test tdbc::sqlite3-19.15 {$connection configure - -timeout} {*}{ -body { catch {::db configure -timeout 5000} result list [::db configure -timeout 0] [::db configure -timeout] } -result {{} 0} } # Information schema tests require additional tables in the database. # Create them now. catch {::db allrows {DROP TABLE d}} catch {::db allrows {DROP TABLE c}} catch {::db allrows {DROP TABLE b}} catch {::db allrows {DROP TABLE a}} ::db allrows { CREATE TABLE a ( k1 INTEGER, CONSTRAINT pk_a PRIMARY KEY(k1) ) } ::db allrows { CREATE TABLE b ( k1 INTEGER, k2 INTEGER, CONSTRAINT pk_b PRIMARY KEY(k1, k2), CONSTRAINT fk_b1 FOREIGN KEY (k1) REFERENCES a(k1), CONSTRAINT fk_b2 FOREIGN KEY (k2) REFERENCES a(k1) ) } ::db allrows { CREATE TABLE c ( p1 INTEGER, p2 INTEGER, CONSTRAINT pk_c PRIMARY KEY(p1, p2), CONSTRAINT fk_c1 FOREIGN KEY (p1) REFERENCES a(k1), CONSTRAINT fk_c2 FOREIGN KEY (p2) REFERENCES a(k1), CONSTRAINT fk_cpair FOREIGN KEY (p1,p2) REFERENCES b(k2,k1) ) } ::db allrows { CREATE TABLE d ( dtext VARCHAR(40) ) } test tdbc::sqlite3-23.1 {Primary keys - no arg} {*}{ -body { ::db primarykeys } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-23.2 {Primary keys - no primary key} {*}{ -body { ::db primarykeys d } -result {} } test tdbc::sqlite3-23.3 {Primary keys - simple primary key} {*}{ -body { set result {} foreach row [::db primarykeys a] { lappend result [dict get $row columnName] [dict get $row ordinalPosition] } set result } -result {k1 1} } test tdbc::sqlite3-23.4 {Primary keys - compound primary key} {*}{ -body { set result {} foreach row [::db primarykeys b] { lappend result [dict get $row columnName] [dict get $row ordinalPosition] } set result } -result {k1 1 k2 2} } test tdbc::sqlite3-24.1 {Foreign keys - wrong # args} {*}{ -body { ::db foreignkeys -wrong } -returnCodes error -match glob -result {wrong # args*} } test tdbc::sqlite3-24.2 {Foreign keys - bad arg} {*}{ -body { ::db foreignkeys -primary a -rubbish b } -returnCodes error -match glob -result {bad option "-rubbish"*} } test tdbc::sqlite3-24.3 {Foreign keys - redundant arg} {*}{ -body { ::db foreignkeys -primary a -primary b } -returnCodes error -match glob -result {duplicate option "primary"*} } test tdbc::sqlite3-24.4 {Foreign keys - list all} \ -body { set result {} set wanted {a {} b {} c {} d {} people {}} foreach row [::db foreignkeys] { if {[dict exists $wanted [dict get $row foreignTable]]} { dict set result [dict get $row foreignConstraintName] \ [dict get $row ordinalPosition] \ [list [dict get $row foreignTable] \ [dict get $row foreignColumn] \ [dict get $row primaryTable] \ [dict get $row primaryColumn]] } } lsort [dict values $result] } \ -result [list \ {1 {b k1 a k1}} \ {1 {b k2 a k1}} \ {1 {c p1 a k1}} \ {1 {c p1 b k2} 2 {c p2 b k1}} \ {1 {c p2 a k1}} \ ] test tdbc::sqlite3-24.5 {Foreign keys - -foreign} \ -body { set result {} set wanted {a {} b {} c {} d {} people {}} foreach row [::db foreignkeys -foreign c] { if {[dict exists $wanted [dict get $row foreignTable]]} { dict set result [dict get $row foreignConstraintName] \ [dict get $row ordinalPosition] \ [list [dict get $row foreignTable] \ [dict get $row foreignColumn] \ [dict get $row primaryTable] \ [dict get $row primaryColumn]] } } lsort [dict values $result] } \ -result [list \ {1 {c p1 a k1}} \ {1 {c p1 b k2} 2 {c p2 b k1}} \ {1 {c p2 a k1}} \ ] test tdbc::sqlite3-24.6 {Foreign keys - -primary} \ -body { set result {} set wanted {a {} b {} c {} d {} people {}} foreach row [::db foreignkeys -primary a] { if {[dict exists $wanted [dict get $row foreignTable]]} { dict set result [dict get $row foreignConstraintName] \ [dict get $row ordinalPosition] \ [list [dict get $row foreignTable] \ [dict get $row foreignColumn] \ [dict get $row primaryTable] \ [dict get $row primaryColumn]] } } lsort [dict values $result] } \ -result [list \ {1 {b k1 a k1}} \ {1 {b k2 a k1}} \ {1 {c p1 a k1}} \ {1 {c p2 a k1}}] test tdbc::sqlite3-24.7 {Foreign keys - -foreign and -primary} \ -body { set result {} set wanted {a {} b {} c {} d {} people {}} foreach row [::db foreignkeys -foreign c -primary b] { if {[dict exists $wanted [dict get $row foreignTable]]} { dict set result [dict get $row foreignConstraintName] \ [dict get $row ordinalPosition] \ [list [dict get $row foreignTable] \ [dict get $row foreignColumn] \ [dict get $row primaryTable] \ [dict get $row primaryColumn]] } } lsort [dict values $result] } \ -result [list {1 {c p1 b k2} 2 {c p2 b k1}}] test tdbc::sqlite3-30.0 {Multiple result sets} {*}{ -body { set stmt [::db prepare { }] catch { set resultset [$stmt execute {}] catch { set rowsets {} while {1} { set rows {} while {[$resultset nextrow row]} { lappend rows $row } lappend rowsets $rows if {[$resultset nextresults] == 0} break } set rowsets } results rename $resultset {} set results } results rename $stmt {} set results } -result {{}} } test tdbc::sqlite3-30.1 {Multiple result sets - but in reality only one} {*}{ -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } -body { set stmt [::db prepare { select idnum, name from people where name = :a; }] catch { set resultset [$stmt execute {a wilma}] catch { set rowsets {} while {1} { set rows {} while {[$resultset nextrow row]} { lappend rows $row } lappend rowsets $rows if {[$resultset nextresults] == 0} break } set rowsets } results rename $resultset {} set results } results rename $stmt {} set results } -result {{{idnum 2 name wilma}}} } test tdbc::sqlite3-30.2 {Multiple result sets - actually multiple} {*}{ -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } -body { set stmt [::db prepare { select idnum, name from people where name = :a; select idnum, name, 1 as something from people where name = :b; }] catch { set resultset [$stmt execute {a wilma b pebbles}] catch { set rowsets {} while {1} { set rows {} while {[$resultset nextrow row]} { lappend rows $row } lappend rowsets $rows if {[$resultset nextresults] == 0} break } set rowsets } results rename $resultset {} set results } results rename $stmt {} set results } -result {{{idnum 2 name wilma}} {{idnum 3 name pebbles something 1}}} } test tdbc::sqlite3-30.3 {Multiple result sets - try to read past end} {*}{ -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } -body { set stmt [::db prepare { select idnum, name from people where name = :a; }] catch { set resultset [$stmt execute {a wilma}] catch { set rowsets {} while {1} { set rows {} while {[$resultset nextrow row]} { lappend rows $row } lappend rowsets $rows if {[$resultset nextresults] == 0} break } lappend rowsets [catch {$resultset nextresults} msg] $msg lappend rowsets [catch {$resultset nextrow foo} msg] $::errorCode set rowsets } results rename $resultset {} set results } results rename $stmt {} set results } -match glob -result {{{idnum 2 name wilma}} 0 0 1 {TDBC GENERAL_ERROR HY010 *}} } test tdbc::sqlite3-30.4 {Multiple result sets - foreach} {*}{ -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } -body { set rows {} ::db foreach -columnsvar c -- row { select idnum, name from people where name = :a; select idnum, name, 1 as something from people where name = :b; } {a wilma b pebbles} { lappend rows $c $row } set rows } -result {{idnum name} {idnum 2 name wilma} {idnum name something} {idnum 3 name pebbles something 1}} } test tdbc::sqlite3-30.5 {Multiple result sets - allrows} {*}{ -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {fred wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} } -body { ::db allrows -as dicts { select idnum, name from people where name = :a; select idnum, name, 1 as something from people where name = :b; } {a wilma b pebbles} } -result {{idnum 2 name wilma} {idnum 3 name pebbles something 1}} } test tdbc::sqlite3-30.6 {Empty result set among multiples} { -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {wilma pebbles barney betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} set stmt [::db prepare { select idnum from people where name = 'fred'; select idnum from people where name = 'barney'; }] set rs [$stmt execute] } -body { set result {} while {1} { lappend result resultset while {[$rs nextdict row]} { lappend result $row } if {[$rs nextresults] == 0} break } set result } -cleanup { rename $rs {} } -result {resultset resultset {idnum 3}} } test tdbc::sqlite3-30.7 {Multiple empty result sets} { -setup { ::db allrows {delete from people} set stmt [db prepare { INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) }] $stmt paramtype idnum integer $stmt paramtype name varchar 40 set idnum 1 foreach name {wilma pebbles betty bam-bam} { set rs [$stmt execute] rename $rs {} incr idnum } rename $stmt {} set stmt [::db prepare { select idnum from people where name = 'fred'; select idnum from people where name = 'barney'; }] set rs [$stmt execute] } -body { set result {} while {1} { lappend result resultset while {[$rs nextdict row]} { lappend result $row } if {[$rs nextresults] == 0} break } set result } -cleanup { rename $rs {} } -result {resultset resultset} } #------------------------------------------------------------------------------- # Test cleanup. Drop tables and get rid of the test database. catch {::db allrows {DROP TABLE d}} catch {::db allrows {DROP TABLE c}} catch {::db allrows {DROP TABLE b}} catch {::db allrows {DROP TABLE a}} catch {::db allrows {DROP TABLE people}} catch {rename ::db {}} removeFile $testFileName $testdir removeDirectory tdbctest cleanupTests return # Local Variables: # mode: tcl # End: