# tdbcmysql.test --
#
#	Tests for the tdbc::mysql 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: tdbcmysql.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $
#
#------------------------------------------------------------------------------

lappend auto_path .
package require tcltest 2
namespace import -force ::tcltest::*
tcltest::loadTestedCommands
package require tdbc::mysql

# We need to know the parameters of the MySQL database for testing.

set connFlags {}
if {[info exists ::env(TDBCMYSQL_TEST_HOST)]} {
    lappend connFlags -host $::env(TDBCMYSQL_TEST_HOST)
}
if {[info exists ::env(TDBCMYSQL_TEST_USER)]} {
    lappend connFlags -user $::env(TDBCMYSQL_TEST_USER)
}
if {[info exists ::env(TDBCMYSQL_TEST_PASSWD)]} {
    lappend connFlags -passwd $::env(TDBCMYSQL_TEST_PASSWD)
}
if {[info exists ::env(TDBCMYSQL_TEST_DB)]} {
    lappend connFlags -db $::env(TDBCMYSQL_TEST_DB)
} else {
    lappend connFlags -db tdbc_test
}
if {[info exists ::env(TDBCMYSQL_TEST_SOCKET)]} {
    lappend connFlags -socket $::env(TDBCMYSQL_TEST_SOCKET)
}
if {[info exists ::env(TDBCMYSQL_TEST_PORT)]} {
    lappend connFlags -port $::env(TDBCMYSQL_TEST_PORT)
}

#------------------------------------------------------------------------------

test tdbc::mysql-1.1 {create a connection, wrong # args} {*}{
    -body {
	tdbc::mysql::connection create
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-1.2 {create a connection, connection string missing} {*}{
    -body {
	tdbc::mysql::connection create db -user
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-1.3 {create a connection, bad arg} {*}{
    -body {
	tdbc::mysql::connection create db -rubbish rubbish
    }
    -returnCodes error
    -match glob
    -result {bad option "-rubbish"*}
}

test tdbc::mysql-1.4 {create a connection, bad flag} {*}{
    -body {
	tdbc::mysql::connection create db -interactive rubbish
    }
    -returnCodes error
    -result {expected boolean value but got "rubbish"}
}

test tdbc::mysql-1.5 {create a connection, bad port} {*}{
    -body {
	tdbc::mysql::connection create db -port rubbish
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
}

test tdbc::mysql-1.6 {create a connection, bad port} {*}{
    -body {
	tdbc::mysql::connection create db -port 999999999999
    }
    -returnCodes error
    -match glob
    -result {integer value too large to represent*}
}

test tdbc::mysql-1.7 {create a connection, bad port} {*}{
    -body {
	tdbc::mysql::connection create db -port -1
    }
    -returnCodes error
    -result {port number must be in range [0..65535]}
}

test tdbc::mysql-1.8 {create a connection, bad port} {*}{
    -body {
	tdbc::mysql::connection create db -port 65536
    }
    -returnCodes error
    -result {port number must be in range [0..65535]}
}

test tdbc::mysql-1.9 {create a connection, failure} {*}{
    -body {
	set status [catch {
	    tdbc::mysql::connection create db -host rubbish.example.com
	} result]
	list $status $result $::errorCode
    }
    -match glob
    -result {1 {Unknown *server host*} {TDBC GENERAL_ERROR HY000 MYSQL *}}
}

#------------------------------------------------------------------------------
#
# Bail out if the user hasn't set TDBCMYSQL_TEST_DB

if {![info exists ::env(TDBCMYSQL_TEST_DB)]} {
    puts "Not performing functional testing of tdbc::mysql because\
          ::env(TDBCMYSQL_TEST_DB) is not set."
    cleanupTests
    return
}

test tdbc::mysql-1.10 {create a connection, successful} {*}{
    -body {
	tdbc::mysql::connection create ::db {*}$connFlags
    }
    -result ::db
    -cleanup {
	catch {rename ::db {}}
    }
}

#------------------------------------------------------------------------------
#
# The tests that follow all require a connection to a database.

tdbc::mysql::connection create ::db {*}$connFlags
catch {::db allrows {DROP TABLE people}}

#------------------------------------------------------------------------------

test tdbc::mysql-2.1 {prepare statement, wrong # args} {*}{
    -body {
	::db prepare
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-2.2 {don't make a statement without a connection} {*}{
    -body {
	tdbc::mysql::statement create stmt rubbish moreRubbish
    }
    -returnCodes error
    -result {rubbish does not refer to an object}
}

test tdbc::mysql-2.3 {don't make a statement without a connection} {*}{
    -body {
	tdbc::mysql::statement create stmt oo::class moreRubbish
    }
    -returnCodes error
    -result {oo::class does not refer to a MySQL connection}
}

test tdbc::mysql-2.4 {semicolons in statements} {*}{
    -body {
	::db prepare {select foo from bar; select grill from quux}
    }
    -returnCodes error
    -result {tdbc::mysql does not support semicolons in statements}
}

test tdbc::mysql-3.1 {prepare an invalid statement} {*}{
    -body {
	set status [catch {
	    ::db prepare {
		RUBBISH
	    }
	} result]
	list $status $result $::errorCode
    }
    -match glob
    -result {1 {*SQL syntax*} {TDBC SYNTAX_ERROR* 42000 MYSQL *}}
}

test tdbc::mysql-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::mysql-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::mysql-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::mysql-3.5 {result set: trying to create against a non-object} {*}{
    -body {
	tdbc::mysql::resultset create rs nothing
    }
    -returnCodes error
    -result {nothing does not refer to an object}
}

test tdbc::mysql-3.6 {result set: trying to create against a non-statement} {*}{
    -body {
	tdbc::mysql::resultset create rs db
    }
    -returnCodes error
    -result {db does not refer to a MySQL 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
    ) ENGINE=InnoDB
}]
set rs [$stmt execute]
rename $rs {}
rename $stmt {}

test tdbc::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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 {*cannot be [nN]ull*}
    -cleanup {
	catch {
	    rename $stmt {}
	    set stmt [::db prepare {
		DELETE FROM people
	    }]
	    set rs [$stmt execute]
	    rename $rs {}
	    rename $stmt {}
	}
    }
}

test tdbc::mysql-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 {*cannot be [nN]ull*}
    -cleanup {
	catch {
	    rename $stmt {}
	    set stmt [::db prepare {
		DELETE FROM people
	    }]
	    set rs [$stmt execute]
	    rename $rs {}
	    rename $stmt {}
	}
    }
}

test tdbc::mysql-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::mysql-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::mysql-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::mysql-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* MYSQL *}}
}

test tdbc::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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]} {
		binary scan [dict get $row idnum] c* v; puts $v
		binary scan [dict get $row name] c* v; puts $v
		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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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 tdbcmysql-9.22 {rs} {
	    $rs foreach -as lists -- row {
		if {[lindex $row 1] eq {betty}} {
		    return [lindex $row 0]
		}
	    }
	    return failed
	}
    }
    -body {
	tdbcmysql-9.22 $rs
    }
    -cleanup {
	rename tdbcmysql-9.22 {}
	rename $rs {}
	rename $stmt {}
    }
    -result 5
}

test tdbc::mysql-9.23 {stmt foreach / return out of the loop} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}]
	proc tdbcmysql-9.23 {stmt} {
	    $stmt foreach -as lists -- row {
		if {[lindex $row 1] eq {betty}} {
		    return [lindex $row 0]
		}
	    }
	    return failed
	}
    }
    -body {
	tdbcmysql-9.23 $stmt
    }
    -cleanup {
	rename tdbcmysql-9.23 {}
	rename $stmt {}
    }
    -result 5
}

test tdbc::mysql-9.24 {db foreach / return out of the loop} {*}{
    -setup {
	proc tdbcmysql-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 {
	tdbcmysql-9.24 $stmt
    }
    -cleanup {
	rename tdbcmysql-9.24 {}
    }
    -result 5
}

test tdbc::mysql-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 tdbcmysql-9.25 {rs} {
	    $rs foreach -as lists -- row {
		if {[lindex $row 1] eq {betty}} {
		    error [lindex $row 0]
		}
	    }
	    return failed
	}
    }
    -body {
	tdbcmysql-9.25 $rs
    }
    -cleanup {
	rename tdbcmysql-9.25 {}
	rename $rs {}
	rename $stmt {}
    }
    -returnCodes error
    -result 5
}

test tdbc::mysql-9.26 {stmt foreach - error out of the loop} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}]
	proc tdbcmysql-9.26 {stmt} {
	    $stmt foreach -as lists -- row {
		if {[lindex $row 1] eq {betty}} {
		    error [lindex $row 0]
		}
	    }
	    return failed
	}
    }
    -body {
	tdbcmysql-9.26 $stmt
    }
    -cleanup {
	rename tdbcmysql-9.26 {}
	rename $stmt {}
    }
    -returnCodes error
    -result 5
}

test tdbc::mysql-9.27 {db foreach / error out of the loop} {*}{
    -setup {
	proc tdbcmysql-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 {
	tdbcmysql-9.27
    }
    -cleanup {
	rename tdbcmysql-9.27 {}
    }
    -returnCodes error
    -result 5
}

test tdbc::mysql-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 tdbcmysql-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 {
	tdbcmysql-9.28 $rs
    }
    -cleanup {
	rename tdbcmysql-9.28 {}
	rename $rs {}
	rename $stmt {}
    }
    -returnCodes 666
    -result 5
}

test tdbc::mysql-9.29 {stmt foreach / unknown status from the loop} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}]
	proc tdbcmysql-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 {
	tdbcmysql-9.29 $stmt
    }
    -cleanup {
	rename tdbcmysql-9.29 {}
	rename $stmt {}
    }
    -returnCodes 666
    -result 5
}

test tdbc::mysql-9.30 {db foreach / unknown status from the loop} {*}{
    -setup {
	proc tdbcmysql-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 {
	tdbcmysql-9.30 $stmt
    }
    -cleanup {
	rename tdbcmysql-9.30 {}
    }
    -returnCodes 666
    -result 5
}

test tdbc::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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::mysql::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::mysql-14.1 {begin transaction - wrong # args} {*}{
    -body {
	::db begintransaction junk
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-14.2 {commit - wrong # args} {*}{
    -body {
	::db commit junk
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-14.3 {rollback - wrong # args} {*}{
    -body {
	::db rollback junk
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-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 MYSQL *}}
}

test tdbc::mysql-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 MYSQL *}}
}

test tdbc::mysql-14.6 {empty transaction} {*}{
    -body {
	::db begintransaction
	::db commit
    }
    -result {}
}

test tdbc::mysql-14.7 {empty rolled-back transaction} {*}{
    -body {
	::db begintransaction
	::db rollback
    }
    -result {}
}

test tdbc::mysql-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::mysql-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::mysql-14.10 {nested transactions} {*}{
    -body {
	::db begintransaction
	list [catch {::db begintransaction} result] $result $::errorCode
    }
    -cleanup {
	catch {::db rollback}
    }
    -match glob
    -result {1 {MySQL does not support nested transactions} {TDBC GENERAL_ERROR HYC00 MYSQL *}}
}

#------------------------------------------------------------------------------
#
# Clean up database again for the next round.

catch {
    set stmt [db prepare {
	DELETE FROM people
    }]
    $stmt execute
}
catch {
    rename ::db {}
}

tdbc::mysql::connection create ::db {*}$::connFlags

# Things should be sane enough that we can find out the database version.
# REFERENTIAL_CONSTRAINTS,REFERENCED_TABLE_COLUMN doesn't exist until 5.1.16,
# and [db foreignkeys] depends on it.

set version unknown
db foreach -as lists -- row {SELECT version()} {
    set version [lindex $row 0]
}
tcltest::testConstraint mysqlAtLeast5116 \
    [expr {[regexp {^\d+\.\d+(?:\.\d+)?} $version components]
	   && [package vcompare $components 5.1.16] >= 0}]

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::mysql-15.1 {successful (empty) transaction} {*}{
    -body {
	db transaction {
	    concat ok
	}
    }
    -result ok
}

test tdbc::mysql-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::mysql-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::mysql-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::mysql-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::mysql-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 tdbcmysql-15.6 {stmt1} {
	    ::db transaction {
		set rs [$stmt1 execute]
		rename $rs {}
		return
	    }
	}
    }
    -body {
	tdbcmysql-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 tdbcmysql-15.6 {}
    }
    -result 10
}

test tdbc::mysql-16.1 {database tables, wrong # args} {
    -body {
	set dict [::db tables % rubbish]
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-16.2 {database tables - empty set} {
    -body {
	::db tables q%
    }
    -result {}
}

test tdbc::mysql-16.3 {enumerate database tables} {*}{
    -body {
	set dict [::db tables]
	list [dict exists $dict people] [dict exists $dict property]
    }
    -result {1 0}
}

test tdbc::mysql-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::mysql-17.1 {database columns - wrong # args} {*}{
    -body {
	set dict [::db columns people % rubbish]
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-17.2 {database columns - no such table} {*}{
    -body {
	::db columns rubbish
    }
    -returnCodes error
    -match glob
    -result {Table * doesn't exist}
}

test tdbc::mysql-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 0 name varchar 40 * info integer * 0 1}
}

# sqlite driver appears not to implement pattern matching for SQLGetColumns
test tdbc::mysql-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]
	}
	set result
    }
    -result {idnum integer 11 0 0 info integer 11 0 1}
}

test tdbc::mysql-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::mysql-18.2 {$statement params - no params} {*}{
    -setup {
	set s [::db prepare {
	    SELECT name FROM people
	}]
    }
    -body {
	$s params
    }
    -cleanup {
	rename $s {}
    }
    -result {}
}

test tdbc::mysql-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::mysql-19.1 {$connection configure - no args} \
    -body {
	::db configure
    } \
    -match glob \
    -result [list \
		 -compress * -database * -encoding utf-8 \
		 -host * -interactive * -isolation repeatableread \
		 -password {} -port * -readonly 0 -socket * \
		 -ssl_ca * -ssl_capath * -ssl_cert * -ssl_cipher * \
		 -ssl_key * -timeout * -user *]

test tdbc::mysql-19.2 {$connection configure - unknown arg} {*}{
    -body {
	::db configure -junk
    }
    -returnCodes error
    -match glob
    -result "bad option *"
}

test tdbc::mysql-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::mysql-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::mysql-19.5 {$connection configure - set inappropriate arg} {*}{
    -body {
	list [catch {::db configure -encoding ebcdic} result] \
	    $result $::errorCode
    }
    -result {1 {"-encoding" option cannot be changed dynamically} {TDBC GENERAL_ERROR HY000 MYSQL -1}}
}

test tdbc::mysql-19.6 {$connection configure - wrong # args} {*}{
    -body {
	::db configure -parent . -junk
    }
    -returnCodes error
    -match glob
    -result "wrong # args*"
}

test tdbc::mysql-19.9 {$connection configure - -encoding} {*}{
    -body {
	::db configure -encoding
    }
    -result utf-8
}


test tdbc::mysql-19.10 {$connection configure - -isolation} {*}{
    -body {
	::db configure -isolation junk
    }
    -returnCodes error
    -match glob
    -result {bad isolation level "junk"*}
}

test tdbc::mysql-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::mysql-19.12 {$connection configure - -readonly} {*}{
    -body {
	::db configure -readonly junk
    }
    -returnCodes error
    -result {"-readonly" option cannot be changed dynamically}
}

test tdbc::mysql-19.13 {$connection configure - -readonly} {*}{
    -body {
	::db configure -readonly
    }
    -result 0
}

test tdbc::mysql-19.14 {$connection configure - -timeout} {*}{
    -body {
	::db configure -timeout junk
    }
    -returnCodes error
    -result {expected integer but got "junk"}
}

test tdbc::mysql-19.15 {$connection configure - -timeout} {*}{
    -body {
	set x [::db configure -timeout]
	list [::db configure -timeout 5000] [::db configure -timeout] \
	    [::db configure -timeout $x]
    }
    -result {{} 5000 {}}
}

test tdbc::mysql-19.16 {$connection configure - -db} {*}{
    -body {
	set x [::db configure -db]
	list [::db configure -db information_schema] \
	    [::db configure -db] \
	    [::db configure -db $x]
    }
    -result {{} information_schema {}}
}

test tdbc::mysql-19.17 {$connection configure - -user} \
    -body {
	set flags $::connFlags
	dict unset flags -host
	catch [dict unset flags -port]
	catch [dict unset flags -socket]
	set flags2 $flags
	dict set flags -db information_schema
	list [::db configure {*}$flags] [::db configure -db] \
	    [::db configure {*}$flags2] [::db configure -db]
    } \
    -result [list {} information_schema {} [dict get $connFlags -db]]

test tdbc::mysql-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 13398}}
    -cleanup {
	db allrows {DROP TABLE bittest}
    }
}

test tdbc::mysql-20.2 {direct value transfers} {*}{
    -setup {
	set bigtext [string repeat a 200]
	set bigbinary [string repeat \xc2\xa1 100]
	catch {db allrows {DROP TABLE typetest}}
	db allrows {
	    CREATE TABLE typetest (
		xtiny1 TINYINT,
		xsmall1 SMALLINT,
		xint1 INTEGER,
		xfloat1 FLOAT,
		xdouble1 DOUBLE,
		xtimestamp1 TIMESTAMP,
		xbig1 BIGINT,
		xmed1 MEDIUMINT,
		xdate1 DATE,
		xtime1 TIME,
		xdatetime1 DATETIME,
		xyear1 YEAR,
		xbit1 BIT(14),
		xdec1 DECIMAL(10),
		xtinyt1 TINYTEXT,
		xtinyb1 TINYBLOB,
		xmedt1 MEDIUMTEXT,
		xmedb1 MEDIUMBLOB,
		xlongt1 LONGTEXT,
		xlongb1 LONGBLOB,
		xtext1 TEXT,
		xblob1 BLOB,
		xvarb1 VARBINARY(256),
		xvarc1 VARCHAR(256),
		xbin1 BINARY(20),
		xchar1 CHAR(20)
	    )
	}
	set stmt [db prepare {
	    INSERT INTO typetest(
		xtiny1,		xsmall1,	xint1,		xfloat1,
		xdouble1,	xtimestamp1,	xbig1,		xmed1,
		xdate1,		xtime1,		xdatetime1,	xyear1,
		xbit1,		xdec1,		xtinyt1,	xtinyb1,
		xmedt1,		xmedb1,		xlongt1,	xlongb1,
		xtext1,		xblob1,		xvarb1,		xvarc1,
		xbin1,		xchar1
	    ) values (
		:xtiny1,	:xsmall1,	:xint1,		:xfloat1,
		:xdouble1,	:xtimestamp1,	:xbig1,		:xmed1,
		:xdate1,	:xtime1,	:xdatetime1,	:xyear1,
		:xbit1,		:xdec1,		:xtinyt1,	:xtinyb1,
		:xmedt1,	:xmedb1,	:xlongt1,	:xlongb1,
		:xtext1,	:xblob1,	:xvarb1,	:xvarc1,
		:xbin1,		:xchar1
	    )
	}]
	$stmt paramtype xtiny1 tinyint
	$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 xmed1 mediumint
	$stmt paramtype xdate1 date
	$stmt paramtype xtime1 time
	$stmt paramtype xdatetime1 datetime
	$stmt paramtype xyear1 year
	$stmt paramtype xbit1 bit 14
	$stmt paramtype xdec1 decimal 10 0
	$stmt paramtype xtinyt1 tinytext
	$stmt paramtype xtinyb1 tinyblob
	$stmt paramtype xmedt1 mediumtext
	$stmt paramtype xmedb1 mediumblob
	$stmt paramtype xlongt1 longtext
	$stmt paramtype xlongb1 longblob
	$stmt paramtype xtext1 text
	$stmt paramtype xblob1 blob
	$stmt paramtype xvarb1 varbinary
	$stmt paramtype xvarc1 varchar
	$stmt paramtype xbin1 binary 20
	$stmt paramtype xchar1 char 20
    }
    -body {
	set trouble {}
	set xtiny1 0x14
	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 xmed1 0x3039
	set xdate1 2001-02-03
	set xtime1 04:05:06
	set xdatetime1 {2001-02-03 04:05:06}
	set xyear1 2001
	set xbit1 0b11010001010110
	set xdec1 0xbc614e
	set xtinyt1 $bigtext
	set xtinyb1 $bigbinary
	set xmedt1 $bigtext
	set xmedb1 $bigbinary
	set xlongt1 $bigtext
	set xlongb1 $bigbinary
	set xtext1 $bigtext
	set xblob1 $bigbinary
	set xvarb1 $bigbinary
	set xvarc1 $bigtext
	set xbin1 [string repeat \xc2\xa1 10]
	set xchar1 [string repeat a 20]
	$stmt allrows
	db foreach row {select * from typetest} {
	    foreach v {
		xtiny1		xsmall1		xint1		xfloat1
		xdouble1	xtimestamp1	xbig1		xmed1
		xdate1		xtime1		xdatetime1	xyear1
		xbit1		xdec1		xtinyt1		xtinyb1
		xmedt1		xmedb1		xlongt1		xlongb1
		xtext1		xblob1		xvarb1		xvarc1
		xbin1		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
	}
    }
}

test tdbc::mysql-21.2 {transfers of binary data} {*}{
    -setup {
	catch {
	    db allrows {DROP TABLE bintest}
	}
	db allrows {
	    CREATE TABLE bintest (
		xint1 INTEGER PRIMARY KEY,
		xbin VARBINARY(256)
	    )
	}
	set stmt1 [db prepare {
	    INSERT INTO bintest (xint1, xbin)
	    VALUES(:i1, :b1)
	}]
	$stmt1 paramtype i1 integer
	$stmt1 paramtype b1 varbinary 256
	set stmt2 [db prepare {
	    SELECT xbin FROM bintest WHERE xint1 = :i1
	}]
	$stmt2 paramtype i1 integer
    }
    -body {
	set listdata {}
	for {set i 0} {$i < 256} {incr i} {
	    lappend listdata $i
	}
	set b1 [binary format c* $listdata]
	set i1 123
	$stmt1 allrows
	$stmt2 foreach -as lists row { set b2 [lindex $row 0] }
	list [string length $b2] [string compare $b1 $b2]
    }
    -result {256 0}
    -cleanup {
	$stmt1 close
	$stmt2 close
	db allrows {DROP TABLE bintest}
    }
}

test tdbc::mysql-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
    }
}

# 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)
    ) ENGINE=InnoDB
}

::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)
    ) ENGINE=InnoDB
}

::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)
    ) ENGINE=InnoDB
}

::db allrows {
    CREATE TABLE d (
	dtext VARCHAR(40)
    ) ENGINE=InnoDB
}

test tdbc::mysql-23.1 {Primary keys - no arg} {*}{
    -body {
	::db primarykeys
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test tdbc::mysql-23.2 {Primary keys - no primary key} {*}{
    -body {
	::db primarykeys d
    }
    -result {}
}
test tdbc::mysql-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::mysql-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::mysql-24.1 {Foreign keys - wrong # args} {*}{
    -body {
	::db foreignkeys -wrong
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::mysql-24.2 {Foreign keys - bad arg} {*}{
    -body {
	::db foreignkeys -primary a -rubbish b
    }
    -returnCodes error
    -match glob
    -result {bad option "-rubbish"*}
}

test tdbc::mysql-24.3 {Foreign keys - redundant arg} {*}{
    -body {
	::db foreignkeys -primary a -primary b
    }
    -returnCodes error
    -match glob
    -result {duplicate option "primary"*}
}

test tdbc::mysql-24.4 {Foreign keys - list all} \
    -constraints mysqlAtLeast5116 \
    -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 p1 b k2} 2 {c p2 b k1}}]

test tdbc::mysql-24.5 {Foreign keys - -foreign} \
    -constraints mysqlAtLeast5116 \
    -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 p1 b k2} 2 {c p2 b k1}}]

test tdbc::mysql-24.6 {Foreign keys - -primary} \
    -constraints mysqlAtLeast5116 \
    -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::mysql-24.7 {Foreign keys - -foreign and -primary} \
    -constraints mysqlAtLeast5116 \
    -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 p1 b k2} 2 {c p2 b k1}}]

# MySQL doesn't "do nothing gracefully", so the empty statement yields an
# error rather than an empty result set.
test tdbc::mysql-30.0 {Multiple result sets} {*}{
    -constraints knownBug
    -setup {
	set stmt [::db prepare { }]
    }
    -body {
	set resultset [$stmt execute {}]
    }
    -cleanup {
	$stmt close
    }
    -returnCodes error
    -result {empty query}
}

test tdbc::mysql-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: