3243 lines
68 KiB
Plaintext
3243 lines
68 KiB
Plaintext
# tdbcpostgres.test --
|
|
#
|
|
# Tests for the tdbc::postgres bridge
|
|
#
|
|
# Copyright (c) 2008 by Slawomir Cygan
|
|
# See the file "license.terms" for information on usage and redistribution
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
#
|
|
#
|
|
#------------------------------------------------------------------------------
|
|
|
|
package require tcltest 2.2
|
|
namespace import -force ::tcltest::*
|
|
loadTestedCommands
|
|
package require tdbc::postgres
|
|
|
|
# We need to know the parameters of the Postgre database for testing.
|
|
|
|
set connFlags {}
|
|
if {[info exists ::env(TDBCPOSTGRES_TEST_HOST)]} {
|
|
lappend connFlags -host $::env(TDBCPOSTGRES_TEST_HOST)
|
|
}
|
|
if {[info exists ::env(TDBCPOSTGRES_TEST_USER)]} {
|
|
lappend connFlags -user $::env(TDBCPOSTGRES_TEST_USER)
|
|
}
|
|
if {[info exists ::env(TDBCPOSTGRES_TEST_PASSWD)]} {
|
|
lappend connFlags -password $::env(TDBCPOSTGRES_TEST_PASSWD)
|
|
}
|
|
if {[info exists ::env(TDBCPOSTGRES_TEST_DB)]} {
|
|
lappend connFlags -db $::env(TDBCPOSTGRES_TEST_DB)
|
|
tcltest::testConstraint connect 1
|
|
} else {
|
|
tcltest::testConstraint connect 0
|
|
}
|
|
if {[info exists ::env(TDBCPOSTGRES_TEST_PORT)]} {
|
|
lappend connFlags -port $::env(TDBCPOSTGRES_TEST_PORT)
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
test tdbc::postgres-1.1 {create a connection, wrong # args} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-1.2 {create a connection, connection string missing} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create db -user
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-1.3 {create a connection, bad arg} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create db -rubbish rubbish
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {bad option "-rubbish"*}
|
|
}
|
|
|
|
test tdbc::postgres-1.4 {create a connection, bad port} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create db -port rubbish
|
|
}
|
|
-returnCodes error
|
|
-result {expected integer but got "rubbish"}
|
|
}
|
|
|
|
test tdbc::postgres-1.5 {create a connection, bad port} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create db -port 999999999999
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {integer value too large to represent*}
|
|
}
|
|
|
|
test tdbc::postgres-1.6 {create a connection, bad port} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create db -port -1
|
|
}
|
|
-returnCodes error
|
|
-result {port number must be in range [0..65535]}
|
|
}
|
|
|
|
test tdbc::postgres-1.7 {create a connection, bad port} {*}{
|
|
-body {
|
|
tdbc::postgres::connection create db -port 65536
|
|
}
|
|
-returnCodes error
|
|
-result {port number must be in range [0..65535]}
|
|
}
|
|
|
|
test tdbc::postgres-1.8 {create a connection, failure} {*}{
|
|
-body {
|
|
set status [catch {
|
|
tdbc::postgres::connection create db -host rubbish.example.com
|
|
} result]
|
|
list $status $result $::errorCode
|
|
}
|
|
-match glob
|
|
-result {1 {could not translate host name*} {TDBC GENERAL_ERROR HY000 POSTGRES *}}
|
|
}
|
|
|
|
test tdbc::postgres-1.9 {create a connection, successful} {*}{
|
|
-constraints connect
|
|
-body {
|
|
tdbc::postgres::connection create ::db {*}$connFlags
|
|
}
|
|
-result ::db
|
|
-cleanup {
|
|
catch {rename ::db {}}
|
|
}
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
|
#
|
|
# The tests that follow all require a connection to a database.
|
|
|
|
if {![tcltest::testConstraint connect]} {
|
|
puts "tests requiring a db connection skipped."
|
|
cleanupTests
|
|
return
|
|
}
|
|
|
|
tdbc::postgres::connection create ::db {*}$connFlags
|
|
catch {::db allrows {DROP TABLE people}}
|
|
|
|
#------------------------------------------------------------------------------
|
|
|
|
test tdbc::postgres-2.1 {prepare statement, wrong # args} {*}{
|
|
-body {
|
|
::db prepare
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-2.2 {don't make a statement without a connection} {*}{
|
|
-body {
|
|
tdbc::postgres::statement create stmt rubbish moreRubbish
|
|
}
|
|
-returnCodes error
|
|
-result {rubbish does not refer to an object}
|
|
}
|
|
|
|
test tdbc::postgres-2.3 {don't make a statement without a connection} {*}{
|
|
-body {
|
|
tdbc::postgres::statement create stmt oo::class moreRubbish
|
|
}
|
|
-returnCodes error
|
|
-result {oo::class does not refer to a Postgres connection}
|
|
}
|
|
|
|
test tdbc::postgres-2.4 {semicolons in statements} {*}{
|
|
-body {
|
|
::db prepare {select foo from bar; select grill from quux}
|
|
}
|
|
-returnCodes error
|
|
-result {tdbc::postgres does not support semicolons in statements}
|
|
}
|
|
|
|
test tdbc::postgres-3.1 {prepare an invalid statement} {*}{
|
|
-body {
|
|
set status [catch {
|
|
::db prepare {
|
|
RUBBISH
|
|
}
|
|
} result]
|
|
list $status $result $::errorCode
|
|
}
|
|
-match glob
|
|
-result {1 {*syntax error*} {TDBC SYNTAX_ERROR* 42601 POSTGRES *}}
|
|
}
|
|
|
|
test tdbc::postgres-3.2 {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::postgres-3.3 {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::postgres-3.4 {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::postgres-3.5 {result set: trying to create against a non-object} {*}{
|
|
-body {
|
|
tdbc::postgres::resultset create rs nothing
|
|
}
|
|
-returnCodes error
|
|
-result {nothing does not refer to an object}
|
|
}
|
|
|
|
test tdbc::postgres-3.6 {result set: trying to create against a non-statement} {*}{
|
|
-body {
|
|
tdbc::postgres::resultset create rs db
|
|
}
|
|
-returnCodes error
|
|
-result {db does not refer to a Postgres statement}
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Following tests need a 'people' table in the database.
|
|
# They also need to use the InnoDB engine, because some of the test cases
|
|
# test transaction support.
|
|
|
|
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::postgres-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::postgres-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::postgres-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::postgres-4.4 {bad dictionary} {*}{
|
|
-body {
|
|
set stmt [::db prepare {
|
|
INSERT INTO people(idnum, name) 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::postgres-4.5 {missing parameter variable} {*}{
|
|
-constraints !sqlite
|
|
-setup {
|
|
catch {unset idnum}
|
|
}
|
|
-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 name fred
|
|
$stmt execute
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {*violates not-null constraint*}
|
|
-cleanup {
|
|
catch {
|
|
rename $stmt {}
|
|
set stmt [::db prepare {
|
|
DELETE FROM people
|
|
}]
|
|
set rs [$stmt execute]
|
|
rename $rs {}
|
|
rename $stmt {}
|
|
}
|
|
}
|
|
}
|
|
|
|
test tdbc::postgres-4.6 {missing parameter in dictionary} {*}{
|
|
-constraints !sqlite
|
|
-body {
|
|
set stmt [::db prepare {
|
|
INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
|
|
}]
|
|
$stmt paramtype idnum integer
|
|
$stmt paramtype name varchar 40
|
|
$stmt execute {name fred}
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {*violates not-null constraint*}
|
|
-cleanup {
|
|
catch {
|
|
rename $stmt {}
|
|
set stmt [::db prepare {
|
|
DELETE FROM people
|
|
}]
|
|
set rs [$stmt execute]
|
|
rename $rs {}
|
|
rename $stmt {}
|
|
}
|
|
}
|
|
}
|
|
|
|
test tdbc::postgres-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::postgres-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::postgres-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::postgres-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 {
|
|
set status [catch {$stmt execute {idnum 1 name barney}} result]
|
|
list $status $::errorCode
|
|
}
|
|
-cleanup {
|
|
rename $stmt {}
|
|
set stmt [::db prepare {
|
|
DELETE FROM people
|
|
}]
|
|
set rs [$stmt execute]
|
|
rename $rs {}
|
|
rename $stmt {}
|
|
}
|
|
-match glob
|
|
-result {1 {TDBC CONSTRAINT_VIOLATION 23* POSTGRES *}}
|
|
}
|
|
|
|
test tdbc::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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 tdbcpostgres-9.22 {rs} {
|
|
$rs foreach -as lists -- row {
|
|
if {[lindex $row 1] eq {betty}} {
|
|
return [lindex $row 0]
|
|
}
|
|
}
|
|
return failed
|
|
}
|
|
}
|
|
-body {
|
|
tdbcpostgres-9.22 $rs
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.22 {}
|
|
rename $rs {}
|
|
rename $stmt {}
|
|
}
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-9.23 {stmt foreach / return out of the loop} {*}{
|
|
-setup {
|
|
set stmt [::db prepare {
|
|
SELECT idnum, name FROM people WHERE name LIKE 'b%'
|
|
}]
|
|
proc tdbcpostgres-9.23 {stmt} {
|
|
$stmt foreach -as lists -- row {
|
|
if {[lindex $row 1] eq {betty}} {
|
|
return [lindex $row 0]
|
|
}
|
|
}
|
|
return failed
|
|
}
|
|
}
|
|
-body {
|
|
tdbcpostgres-9.23 $stmt
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.23 {}
|
|
rename $stmt {}
|
|
}
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-9.24 {db foreach / return out of the loop} {*}{
|
|
-setup {
|
|
proc tdbcpostgres-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 {
|
|
tdbcpostgres-9.24 $stmt
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.24 {}
|
|
}
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-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 tdbcpostgres-9.25 {rs} {
|
|
$rs foreach -as lists -- row {
|
|
if {[lindex $row 1] eq {betty}} {
|
|
error [lindex $row 0]
|
|
}
|
|
}
|
|
return failed
|
|
}
|
|
}
|
|
-body {
|
|
tdbcpostgres-9.25 $rs
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.25 {}
|
|
rename $rs {}
|
|
rename $stmt {}
|
|
}
|
|
-returnCodes error
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-9.26 {stmt foreach - error out of the loop} {*}{
|
|
-setup {
|
|
set stmt [::db prepare {
|
|
SELECT idnum, name FROM people WHERE name LIKE 'b%'
|
|
}]
|
|
proc tdbcpostgres-9.26 {stmt} {
|
|
$stmt foreach -as lists -- row {
|
|
if {[lindex $row 1] eq {betty}} {
|
|
error [lindex $row 0]
|
|
}
|
|
}
|
|
return failed
|
|
}
|
|
}
|
|
-body {
|
|
tdbcpostgres-9.26 $stmt
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.26 {}
|
|
rename $stmt {}
|
|
}
|
|
-returnCodes error
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-9.27 {db foreach / error out of the loop} {*}{
|
|
-setup {
|
|
proc tdbcpostgres-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 {
|
|
tdbcpostgres-9.27
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.27 {}
|
|
}
|
|
-returnCodes error
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-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 tdbcpostgres-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 {
|
|
tdbcpostgres-9.28 $rs
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.28 {}
|
|
rename $rs {}
|
|
rename $stmt {}
|
|
}
|
|
-returnCodes 666
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-9.29 {stmt foreach / unknown status from the loop} {*}{
|
|
-setup {
|
|
set stmt [::db prepare {
|
|
SELECT idnum, name FROM people WHERE name LIKE 'b%'
|
|
}]
|
|
proc tdbcpostgres-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 {
|
|
tdbcpostgres-9.29 $stmt
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.29 {}
|
|
rename $stmt {}
|
|
}
|
|
-returnCodes 666
|
|
-result 5
|
|
}
|
|
|
|
test tdbc::postgres-9.30 {db foreach / unknown status from the loop} {*}{
|
|
-setup {
|
|
proc tdbcpostgres-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 {
|
|
tdbcpostgres-9.30 $stmt
|
|
}
|
|
-cleanup {
|
|
rename tdbcpostgres-9.30 {}
|
|
}
|
|
-returnCodes 666
|
|
-result 5
|
|
}
|
|
|
|
|
|
test tdbc::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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}
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# 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::postgres::connection create ::db {*}$::connFlags
|
|
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::postgres-14.1 {begin transaction - wrong # args} {*}{
|
|
-body {
|
|
::db begintransaction junk
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-14.2 {commit - wrong # args} {*}{
|
|
-body {
|
|
::db commit junk
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-14.3 {rollback - wrong # args} {*}{
|
|
-body {
|
|
::db rollback junk
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-14.4 {commit - not in transaction} {*}{
|
|
-body {
|
|
list [catch {::db commit} result] $result $::errorCode
|
|
}
|
|
-match glob
|
|
-result {1 {no transaction is in progress} {TDBC GENERAL_ERROR HY010 POSTGRES *}}
|
|
}
|
|
|
|
test tdbc::postgres-14.5 {rollback - not in transaction} {*}{
|
|
-body {
|
|
list [catch {::db rollback} result] $result $::errorCode
|
|
}
|
|
-match glob
|
|
-result {1 {no transaction is in progress} {TDBC GENERAL_ERROR HY010 POSTGRES *}}
|
|
}
|
|
|
|
test tdbc::postgres-14.6 {empty transaction} {*}{
|
|
-body {
|
|
::db begintransaction
|
|
::db commit
|
|
}
|
|
-result {}
|
|
}
|
|
|
|
test tdbc::postgres-14.7 {empty rolled-back transaction} {*}{
|
|
-body {
|
|
::db begintransaction
|
|
::db rollback
|
|
}
|
|
-result {}
|
|
}
|
|
|
|
test tdbcpostgres-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::postgres-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::postgres-14.10 {nested transactions} {*}{
|
|
-body {
|
|
::db begintransaction
|
|
list [catch {::db begintransaction} result] $result $::errorCode
|
|
}
|
|
-cleanup {
|
|
catch {::db rollback}
|
|
}
|
|
-match glob
|
|
-result {1 {Postgres does not support nested transactions} {TDBC GENERAL_ERROR HYC00 POSTGRES *}}
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
#
|
|
# Clean up database again for the next round.
|
|
|
|
catch {
|
|
set stmt [db prepare {
|
|
DELETE FROM people
|
|
}]
|
|
$stmt execute
|
|
}
|
|
catch {
|
|
rename ::db {}
|
|
}
|
|
|
|
tdbc::postgres::connection create ::db {*}$::connFlags
|
|
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::postgres-15.1 {successful (empty) transaction} {*}{
|
|
-body {
|
|
db transaction {
|
|
concat ok
|
|
}
|
|
}
|
|
-result ok
|
|
}
|
|
|
|
test tdbc::postgres-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::postgres-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::postgres-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::postgres-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::postgres-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 tdbcpostgres-15.6 {stmt1} {
|
|
::db transaction {
|
|
set rs [$stmt1 execute]
|
|
rename $rs {}
|
|
return
|
|
}
|
|
}
|
|
}
|
|
-body {
|
|
tdbcpostgres-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 tdbcpostgres-15.6 {}
|
|
}
|
|
-result 10
|
|
}
|
|
|
|
test tdbc::postgres-16.1 {database tables, wrong # args} {
|
|
-body {
|
|
set dict [::db tables % rubbish]
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-16.2 {database tables - empty set} {
|
|
-body {
|
|
::db tables q%
|
|
}
|
|
-result {}
|
|
}
|
|
|
|
test tdbc::postgres-16.3 {enumerate database tables} {*}{
|
|
-body {
|
|
set dict [::db tables]
|
|
list [dict exists $dict people] [dict exists $dict property]
|
|
}
|
|
-result {1 0}
|
|
}
|
|
|
|
test tdbc::postgres-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::postgres-17.1 {database columns - wrong # args} {*}{
|
|
-body {
|
|
set dict [::db columns people % rubbish]
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-17.2 {database columns - no such table} {*}{
|
|
-body {
|
|
::db columns rubbish
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {relation * does not exist}
|
|
}
|
|
|
|
|
|
|
|
test tdbc::postgres-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]
|
|
}
|
|
lsort -stride 5 $result
|
|
}
|
|
-match glob
|
|
-result {idnum integer * 0 0 info integer * 0 1 name varchar 40 *}
|
|
}
|
|
|
|
# TODO: precision not a number of bytes?!
|
|
# -result {idnum integer 11 0 0 info integer 11 0 1}
|
|
|
|
test tdbc::postgres-17.4 {database columns - match pattern} {*}{
|
|
-constraints !sqlite
|
|
-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]
|
|
}
|
|
lsort -stride 5 $result
|
|
}
|
|
-result {idnum integer 32 0 0 info integer 32 0 1}
|
|
}
|
|
|
|
test tdbc::postgres-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::postgres-18.2 {$statement params - no params} {*}{
|
|
-setup {
|
|
set s [::db prepare {
|
|
SELECT name FROM people
|
|
}]
|
|
}
|
|
-body {
|
|
$s params
|
|
}
|
|
-cleanup {
|
|
rename $s {}
|
|
}
|
|
-result {}
|
|
}
|
|
|
|
test tdbc::postgres-18.3 {$statement params - try a few data types} {*}{
|
|
-setup {
|
|
set s [::db prepare {
|
|
SELECT name FROM people
|
|
WHERE name LIKE :pattern
|
|
AND idnum >= :minid
|
|
}]
|
|
$s paramtype minid decimal 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 decimal 10 0 in varchar 40}
|
|
}
|
|
|
|
test tdbc::postgres-18.4 {$statement params - default param types} {
|
|
-setup {
|
|
set s [::db prepare {
|
|
SELECT name FROM people
|
|
WHERE name LIKE :pattern
|
|
AND idnum >= :minid
|
|
}]
|
|
}
|
|
-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] \
|
|
[dict get $d pattern scale]
|
|
}
|
|
-cleanup {
|
|
rename $s {}
|
|
}
|
|
-result {in integer 0 0 in text 0 0}
|
|
}
|
|
|
|
test tdbc::postgres-18.5 {statement with parameter of indeterminate type} {
|
|
-setup {
|
|
set s [::db prepare {SELECT :foo::VARCHAR}]
|
|
}
|
|
-body {
|
|
set d [$s params]
|
|
list \
|
|
[dict get $d foo direction] \
|
|
[dict get $d foo type] \
|
|
[dict get $d foo precision] \
|
|
[dict get $d foo scale]
|
|
}
|
|
-cleanup {
|
|
rename $s {}
|
|
}
|
|
-result {in varchar 0 0}
|
|
}
|
|
|
|
test tdbc::postgres-19.1 {$connection configure - no args} \
|
|
-setup {
|
|
::db configure -encoding UTF8
|
|
} \
|
|
-body {
|
|
::db configure
|
|
} \
|
|
-match glob \
|
|
-result [list \
|
|
-host * -hostaddr * -port * \
|
|
-database * -user * -password * \
|
|
-options {} -tty {} -service {} -timeout {} \
|
|
-sslmode * -requiressl * -krbsrvname * \
|
|
-encoding UTF8 -isolation readcommitted \
|
|
-readonly 0 ]
|
|
|
|
test tdbc::postgres-19.2 {$connection configure - unknown arg} {*}{
|
|
-body {
|
|
::db configure -junk
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result "bad option *"
|
|
}
|
|
|
|
test tdbc::postgres-19.3 {$connection configure - unknown arg} {*}{
|
|
-body {
|
|
list [catch {::db configure -rubbish} result] $result $::errorCode
|
|
}
|
|
-match glob
|
|
-result {1 {bad option "-rubbish": must be *} {TCL LOOKUP INDEX option -rubbish}}
|
|
}
|
|
|
|
test tdbc::postgres-19.4 {$connection configure - set unknown arg} {*}{
|
|
-body {
|
|
list [catch {::db configure -rubbish rubbish} result] \
|
|
$result $::errorCode
|
|
}
|
|
-match glob
|
|
-result {1 {bad option "-rubbish": must be *} {TCL LOOKUP INDEX option -rubbish}}
|
|
}
|
|
|
|
test tdbc::postgres-19.5 {$connection configure - set inappropriate arg} {*}{
|
|
-body {
|
|
list [catch {::db configure -host rubbish} result] \
|
|
$result $::errorCode
|
|
}
|
|
-result {1 {"-host" option cannot be changed dynamically} {TDBC GENERAL_ERROR HY000 POSTGRES -1}}
|
|
}
|
|
|
|
test tdbc::postgres-19.6 {$connection configure - wrong # args} {*}{
|
|
-body {
|
|
::db configure -parent . -junk
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result "wrong # args*"
|
|
}
|
|
|
|
test tdbc::postgres-19.9 {$connection configure - -encoding} {*}{
|
|
-setup {
|
|
::db configure -encoding UTF8
|
|
}
|
|
-body {
|
|
::db configure -encoding
|
|
}
|
|
-result UTF8
|
|
}
|
|
|
|
|
|
test tdbc::postgres-19.10 {$connection configure - -isolation} {*}{
|
|
-body {
|
|
::db configure -isolation junk
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {bad isolation level "junk"*}
|
|
}
|
|
|
|
test tdbc::postgres-19.11 {$connection configure - -isolation} {*}{
|
|
-body {
|
|
list [::db configure -isolation readuncommitted] \
|
|
[::db configure -isolation] \
|
|
[::db configure -isolation readcommitted] \
|
|
[::db configure -isolation] \
|
|
[::db configure -isolation serializable] \
|
|
[::db configure -isolation] \
|
|
[::db configure -isolation repeatableread] \
|
|
[::db configure -isolation]
|
|
}
|
|
-result {{} readuncommitted {} readcommitted {} serializable {} repeatableread}
|
|
}
|
|
|
|
test tdbc::postgres-19.12 {$connection configure - -readonly set inappropriate arg } {*}{
|
|
-body {
|
|
::db configure -readonly junk
|
|
}
|
|
-returnCodes error
|
|
-result {expected boolean value but got "junk"}
|
|
}
|
|
|
|
test tdbc::postgres-19.13 {$connection configure - -readonly} {*}{
|
|
-body {
|
|
list [::db configure -readonly] \
|
|
[::db configure -readonly 1] \
|
|
[::db configure -readonly] \
|
|
[::db configure -readonly 0] \
|
|
[::db configure -readonly]
|
|
}
|
|
-result {0 {} 1 {} 0}
|
|
}
|
|
|
|
test tdbc::postgres-19.14 {$connection configure - -timeout} {*}{
|
|
-body {
|
|
::db configure -timeout junk
|
|
}
|
|
-returnCodes error
|
|
-result {"-timeout" option cannot be changed dynamically}
|
|
}
|
|
|
|
|
|
test tdbc::postgres-19.15 {$connection configure - -db} {*}{
|
|
-body {
|
|
::db configure -db information_schema
|
|
}
|
|
-returnCodes error
|
|
-result {"-db" option cannot be changed dynamically}
|
|
}
|
|
|
|
test tdbc::postgres-19.16 {$connection configure - -user} \
|
|
-body {
|
|
::db configure -user nobody
|
|
} \
|
|
-returnCodes error \
|
|
-result {"-user" option cannot be changed dynamically} \
|
|
|
|
|
|
test tdbc::postgres-22.1 {duplicate column name} {*}{
|
|
-body {
|
|
set stmt [::db prepare {
|
|
SELECT a.idnum, b.idnum
|
|
FROM people a, people b
|
|
WHERE a.name = 'hud rockstone'
|
|
AND b.info = a.info
|
|
}]
|
|
set rs [$stmt execute]
|
|
$rs columns
|
|
}
|
|
-result {idnum idnum#2}
|
|
-cleanup {
|
|
$rs close
|
|
$stmt close
|
|
}
|
|
}
|
|
|
|
test tdbc::postgres-20.1 {bit values} {*}{
|
|
-setup {
|
|
catch {db allrows {DROP TABLE bittest}}
|
|
db allrows {
|
|
CREATE TABLE bittest (
|
|
bitstring BIT(14)
|
|
)
|
|
}
|
|
db allrows {INSERT INTO bittest(bitstring) VALUES(b'11010001010110')}
|
|
}
|
|
-body {
|
|
db allrows {SELECT bitstring FROM bittest}
|
|
}
|
|
-result {{bitstring 11010001010110}}
|
|
-cleanup {
|
|
db allrows {DROP TABLE bittest}
|
|
}
|
|
}
|
|
|
|
test tdbc::postgres-20.2 {direct value transfers} {*}{
|
|
-setup {
|
|
set bigtext [string repeat a 200]
|
|
set bigbinary {}
|
|
for {set i 1} {$i < 256} {incr i} {
|
|
append bigbinary [format %c $i]
|
|
}
|
|
catch {db allrows {DROP TABLE typetest}}
|
|
db allrows {
|
|
CREATE TABLE typetest (
|
|
xsmall1 SMALLINT,
|
|
xint1 INTEGER,
|
|
xfloat1 FLOAT,
|
|
xdouble1 DOUBLE PRECISION,
|
|
xtimestamp1 TIMESTAMP,
|
|
xbig1 BIGINT,
|
|
xdate1 DATE,
|
|
xtime1 TIME,
|
|
xbit1 BIT(14),
|
|
xdec1 DECIMAL(10),
|
|
xtext1 TEXT,
|
|
xvarb1 BYTEA,
|
|
xvarc1 VARCHAR(256),
|
|
xchar1 CHAR(20)
|
|
)
|
|
}
|
|
set stmt [db prepare {
|
|
INSERT INTO typetest(
|
|
xsmall1, xint1, xfloat1,
|
|
xdouble1, xtimestamp1, xbig1,
|
|
xdate1, xtime1, xbit1,
|
|
xdec1, xtext1, xvarb1,
|
|
xvarc1, xchar1
|
|
) values (
|
|
:xsmall1, :xint1, :xfloat1,
|
|
:xdouble1, :xtimestamp1, :xbig1,
|
|
:xdate1, :xtime1, :xbit1,
|
|
:xdec1, :xtext1, :xvarb1,
|
|
:xvarc1, :xchar1
|
|
)
|
|
}]
|
|
$stmt paramtype xsmall1 smallint
|
|
$stmt paramtype xint1 integer
|
|
$stmt paramtype xfloat1 float
|
|
$stmt paramtype xdouble1 double
|
|
$stmt paramtype xtimestamp1 timestamp
|
|
$stmt paramtype xbig1 bigint
|
|
$stmt paramtype xdate1 date
|
|
$stmt paramtype xtime1 time
|
|
$stmt paramtype xbit1 bit 14
|
|
$stmt paramtype xdec1 decimal 10 0
|
|
$stmt paramtype xtext1 text
|
|
$stmt paramtype xvarb1 varbinary
|
|
$stmt paramtype xvarc1 varchar
|
|
$stmt paramtype xchar1 char 20
|
|
}
|
|
-body {
|
|
set trouble {}
|
|
set xsmall1 0x3039
|
|
set xint1 0xbc614e
|
|
set xfloat1 1.125
|
|
set xdouble1 1.125
|
|
set xtimestamp1 {2001-02-03 04:05:06}
|
|
set xbig1 0xbc614e
|
|
set xdate1 2001-02-03
|
|
set xtime1 04:05:06
|
|
set xbit1 01101000101011
|
|
set xdec1 0xbc614e
|
|
set xtext1 $bigtext
|
|
set xvarb1 $bigbinary
|
|
set xvarc1 $bigtext
|
|
set xchar1 [string repeat a 20]
|
|
$stmt allrows
|
|
db foreach row {select * from typetest} {
|
|
foreach v {
|
|
xsmall1 xint1 xfloat1
|
|
xdouble1 xtimestamp1 xbig1
|
|
xdate1 xtime1 xbit1
|
|
xdec1 xtext1 xvarb1
|
|
xvarc1 xchar1
|
|
} {
|
|
if {![dict exists $row $v]} {
|
|
append trouble $v " did not appear in result set\n"
|
|
} elseif {[set $v] != [dict get $row $v]} {
|
|
append trouble [list $v is [dict get $row $v] \
|
|
should be [set $v]] \n
|
|
}
|
|
}
|
|
}
|
|
set trouble
|
|
}
|
|
-result {}
|
|
-cleanup {
|
|
$stmt close
|
|
db allrows {
|
|
DROP TABLE typetest
|
|
}
|
|
}
|
|
}
|
|
|
|
# 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}}
|
|
|
|
# The MyISAM engine doesn't track foreign key constraints, so force the
|
|
# tables to be InnoDB.
|
|
|
|
::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 (p2,p1) REFERENCES b(k1,k2)
|
|
)
|
|
}
|
|
|
|
::db allrows {
|
|
CREATE TABLE d (
|
|
dtext VARCHAR(40)
|
|
)
|
|
}
|
|
|
|
test tdbc::postgres-23.1 {Primary keys - no arg} {*}{
|
|
-body {
|
|
::db primarykeys
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
test tdbc::postgres-23.2 {Primary keys - no primary key} {*}{
|
|
-body {
|
|
::db primarykeys d
|
|
}
|
|
-result {}
|
|
}
|
|
test tdbc::postgres-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::postgres-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::postgres-24.1 {Foreign keys - wrong # args} {*}{
|
|
-body {
|
|
::db foreignkeys -wrong
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {wrong # args*}
|
|
}
|
|
|
|
test tdbc::postgres-24.2 {Foreign keys - bad arg} {*}{
|
|
-body {
|
|
::db foreignkeys -primary a -rubbish b
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {bad option "-rubbish"*}
|
|
}
|
|
|
|
test tdbc::postgres-24.3 {Foreign keys - redundant arg} {*}{
|
|
-body {
|
|
::db foreignkeys -primary a -primary b
|
|
}
|
|
-returnCodes error
|
|
-match glob
|
|
-result {duplicate option "primary"*}
|
|
}
|
|
|
|
test tdbc::postgres-24.4 {Foreign keys - list all} \
|
|
-body {
|
|
set result {}
|
|
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
|
|
foreach row [::db foreignkeys] {
|
|
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
|
|
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 -index 0 -stride 2 $result
|
|
} \
|
|
-result [list \
|
|
fk_b1 {1 {b k1 a k1}} \
|
|
fk_b2 {1 {b k2 a k1}} \
|
|
fk_c1 {1 {c p1 a k1}} \
|
|
fk_c2 {1 {c p2 a k1}} \
|
|
fk_cpair {1 {c p2 b k1} 2 {c p1 b k2}}]
|
|
|
|
test tdbc::postgres-24.5 {Foreign keys - -foreign} \
|
|
-body {
|
|
set result {}
|
|
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
|
|
foreach row [::db foreignkeys -foreign c] {
|
|
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
|
|
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 -index 0 -stride 2 $result
|
|
} \
|
|
-result [list \
|
|
fk_c1 {1 {c p1 a k1}} \
|
|
fk_c2 {1 {c p2 a k1}} \
|
|
fk_cpair {1 {c p2 b k1} 2 {c p1 b k2}}]
|
|
|
|
test tdbc::postgres-24.6 {Foreign keys - -primary} \
|
|
-body {
|
|
set result {}
|
|
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
|
|
foreach row [::db foreignkeys -primary a] {
|
|
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
|
|
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 -index 0 -stride 2 $result
|
|
} \
|
|
-result [list \
|
|
fk_b1 {1 {b k1 a k1}} \
|
|
fk_b2 {1 {b k2 a k1}} \
|
|
fk_c1 {1 {c p1 a k1}} \
|
|
fk_c2 {1 {c p2 a k1}}]
|
|
|
|
test tdbc::postgres-24.7 {Foreign keys - -foreign and -primary} \
|
|
-body {
|
|
set result {}
|
|
set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
|
|
foreach row [::db foreignkeys -foreign c -primary b] {
|
|
if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
|
|
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 -index 0 -stride 2 $result
|
|
} \
|
|
-result [list fk_cpair {1 {c p2 b k1} 2 {c p1 b k2}}]
|
|
|
|
test tdbc::postgres-30.0 {Multiple result sets} {*}{
|
|
-setup {
|
|
set stmt [::db prepare { }]
|
|
}
|
|
-body {
|
|
set resultset [$stmt execute {}]
|
|
}
|
|
-cleanup {
|
|
$stmt close
|
|
}
|
|
-returnCodes error
|
|
-result {empty query}
|
|
}
|
|
|
|
test tdbc::postgres-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 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 {}}
|
|
|
|
cleanupTests
|
|
return
|
|
|
|
# Local Variables:
|
|
# mode: tcl
|
|
# End:
|