util/src/TclTk/tcl8.6.12/pkgs/tdbcmysql1.1.3/tests/tdbcmysql.test

   1 # tdbcmysql.test --
   2 #
   3 #       Tests for the tdbc::mysql bridge
   4 #
   5 # Copyright (c) 2008 by Kevin B. Kenny
   6 # See the file "license.terms" for information on usage and redistribution
   7 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   8 #
   9 # RCS: @(#) $Id: tdbcmysql.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $
  10 #
  11 #------------------------------------------------------------------------------
  12
  13 lappend auto_path .
  14 package require tcltest 2
  15 namespace import -force ::tcltest::*
  16 tcltest::loadTestedCommands
  17 package require tdbc::mysql
  18
  19 # We need to know the parameters of the MySQL database for testing.
  20
  21 set connFlags {}
  22 if {[info exists ::env(TDBCMYSQL_TEST_HOST)]} {
  23     lappend connFlags -host $::env(TDBCMYSQL_TEST_HOST)
  24 }
  25 if {[info exists ::env(TDBCMYSQL_TEST_USER)]} {
  26     lappend connFlags -user $::env(TDBCMYSQL_TEST_USER)
  27 }
  28 if {[info exists ::env(TDBCMYSQL_TEST_PASSWD)]} {
  29     lappend connFlags -passwd $::env(TDBCMYSQL_TEST_PASSWD)
  30 }
  31 if {[info exists ::env(TDBCMYSQL_TEST_DB)]} {
  32     lappend connFlags -db $::env(TDBCMYSQL_TEST_DB)
  33 } else {
  34     lappend connFlags -db tdbc_test
  35 }
  36 if {[info exists ::env(TDBCMYSQL_TEST_SOCKET)]} {
  37     lappend connFlags -socket $::env(TDBCMYSQL_TEST_SOCKET)
  38 }
  39 if {[info exists ::env(TDBCMYSQL_TEST_PORT)]} {
  40     lappend connFlags -port $::env(TDBCMYSQL_TEST_PORT)
  41 }
  42
  43 #------------------------------------------------------------------------------
  44
  45 test tdbc::mysql-1.1 {create a connection, wrong # args} {*}{
  46     -body {
  47         tdbc::mysql::connection create
  48     }
  49     -returnCodes error
  50     -match glob
  51     -result {wrong # args*}
  52 }
  53
  54 test tdbc::mysql-1.2 {create a connection, connection string missing} {*}{
  55     -body {
  56         tdbc::mysql::connection create db -user
  57     }
  58     -returnCodes error
  59     -match glob
  60     -result {wrong # args*}
  61 }
  62
  63 test tdbc::mysql-1.3 {create a connection, bad arg} {*}{
  64     -body {
  65         tdbc::mysql::connection create db -rubbish rubbish
  66     }
  67     -returnCodes error
  68     -match glob
  69     -result {bad option "-rubbish"*}
  70 }
  71
  72 test tdbc::mysql-1.4 {create a connection, bad flag} {*}{
  73     -body {
  74         tdbc::mysql::connection create db -interactive rubbish
  75     }
  76     -returnCodes error
  77     -result {expected boolean value but got "rubbish"}
  78 }
  79
  80 test tdbc::mysql-1.5 {create a connection, bad port} {*}{
  81     -body {
  82         tdbc::mysql::connection create db -port rubbish
  83     }
  84     -returnCodes error
  85     -result {expected integer but got "rubbish"}
  86 }
  87
  88 test tdbc::mysql-1.6 {create a connection, bad port} {*}{
  89     -body {
  90         tdbc::mysql::connection create db -port 999999999999
  91     }
  92     -returnCodes error
  93     -match glob
  94     -result {integer value too large to represent*}
  95 }
  96
  97 test tdbc::mysql-1.7 {create a connection, bad port} {*}{
  98     -body {
  99         tdbc::mysql::connection create db -port -1
 100     }
 101     -returnCodes error
 102     -result {port number must be in range [0..65535]}
 103 }
 104
 105 test tdbc::mysql-1.8 {create a connection, bad port} {*}{
 106     -body {
 107         tdbc::mysql::connection create db -port 65536
 108     }
 109     -returnCodes error
 110     -result {port number must be in range [0..65535]}
 111 }
 112
 113 test tdbc::mysql-1.9 {create a connection, failure} {*}{
 114     -body {
 115         set status [catch {
 116             tdbc::mysql::connection create db -host rubbish.example.com
 117         } result]
 118         list $status $result $::errorCode
 119     }
 120     -match glob
 121     -result {1 {Unknown MySQL server host*} {TDBC GENERAL_ERROR HY000 MYSQL *}}
 122 }
 123
 124 #------------------------------------------------------------------------------
 125 #
 126 # Bail out if the user hasn't set TDBCMYSQL_TEST_DB
 127
 128 if {![info exists ::env(TDBCMYSQL_TEST_DB)]} {
 129     puts "Not performing functional testing of tdbc::mysql because\
 130           ::env(TDBCMYSQL_TEST_DB) is not set."
 131     cleanupTests
 132     return
 133 }
 134
 135 test tdbc::mysql-1.10 {create a connection, successful} {*}{
 136     -body {
 137         tdbc::mysql::connection create ::db {*}$connFlags
 138     }
 139     -result ::db
 140     -cleanup {
 141         catch {rename ::db {}}
 142     }
 143 }
 144
 145 #------------------------------------------------------------------------------
 146 #
 147 # The tests that follow all require a connection to a database.
 148
 149 tdbc::mysql::connection create ::db {*}$connFlags
 150 catch {::db allrows {DROP TABLE people}}
 151
 152 #------------------------------------------------------------------------------
 153
 154 test tdbc::mysql-2.1 {prepare statement, wrong # args} {*}{
 155     -body {
 156         ::db prepare
 157     }
 158     -returnCodes error
 159     -match glob
 160     -result {wrong # args*}
 161 }
 162
 163 test tdbc::mysql-2.2 {don't make a statement without a connection} {*}{
 164     -body {
 165         tdbc::mysql::statement create stmt rubbish moreRubbish
 166     }
 167     -returnCodes error
 168     -result {rubbish does not refer to an object}
 169 }
 170
 171 test tdbc::mysql-2.3 {don't make a statement without a connection} {*}{
 172     -body {
 173         tdbc::mysql::statement create stmt oo::class moreRubbish
 174     }
 175     -returnCodes error
 176     -result {oo::class does not refer to a MySQL connection}
 177 }
 178
 179 test tdbc::mysql-2.4 {semicolons in statements} {*}{
 180     -body {
 181         ::db prepare {select foo from bar; select grill from quux}
 182     }
 183     -returnCodes error
 184     -result {tdbc::mysql does not support semicolons in statements}
 185 }
 186
 187 test tdbc::mysql-3.1 {prepare an invalid statement} {*}{
 188     -body {
 189         set status [catch {
 190             ::db prepare {
 191                 RUBBISH
 192             }
 193         } result]
 194         list $status $result $::errorCode
 195     }
 196     -match glob
 197     -result {1 {*SQL syntax*} {TDBC SYNTAX_ERROR* 42000 MYSQL *}}
 198 }
 199
 200 test tdbc::mysql-3.2 {prepare a valid statement} {*}{
 201     -body {
 202         set stmt [::db prepare {
 203             CREATE TABLE people(
 204                 idnum INTEGER PRIMARY KEY,
 205                 name VARCHAR(40) NOT NULL
 206             )
 207         }]
 208     }
 209     -match glob
 210     -result *Stmt*
 211     -cleanup {
 212         catch [rename $stmt {}]
 213     }
 214 }
 215
 216 test tdbc::mysql-3.3 {execute a valid statement with no results} {*}{
 217     -body {
 218         set stmt [::db prepare {
 219             CREATE TABLE people(
 220                 idnum INTEGER PRIMARY KEY,
 221                 name VARCHAR(40) NOT NULL
 222             )
 223         }]
 224         set rs [$stmt execute]
 225         list [expr {[$rs rowcount] <= 0}] [$rs columns] [$rs nextrow nothing]
 226     }
 227     -result {1 {} 0}
 228     -cleanup {
 229         catch {
 230             rename $rs {}
 231             rename $stmt {}
 232             set stmt [::db prepare {
 233                 DROP TABLE people
 234             }]
 235             set rs [$stmt execute]
 236             rename $rs {}
 237             rename $stmt {}
 238         }
 239     }
 240 }
 241
 242 test tdbc::mysql-3.4 {result set: wrong # args} {*}{
 243     -body {
 244         set stmt [::db prepare {
 245             CREATE TABLE people(
 246                 idnum INTEGER PRIMARY KEY,
 247                 name VARCHAR(40) NOT NULL
 248             )
 249         }]
 250         $stmt execute with extra args
 251     }
 252     -returnCodes error
 253     -match glob
 254     -result {wrong # args*}
 255     -cleanup {
 256         catch [rename $stmt {}]
 257     }
 258 }
 259
 260 test tdbc::mysql-3.5 {result set: trying to create against a non-object} {*}{
 261     -body {
 262         tdbc::mysql::resultset create rs nothing
 263     }
 264     -returnCodes error
 265     -result {nothing does not refer to an object}
 266 }
 267
 268 test tdbc::mysql-3.6 {result set: trying to create against a non-statement} {*}{
 269     -body {
 270         tdbc::mysql::resultset create rs db
 271     }
 272     -returnCodes error
 273     -result {db does not refer to a MySQL statement}
 274 }
 275
 276 #-------------------------------------------------------------------------------
 277 #
 278 # Following tests need a 'people' table in the database.
 279 # They also need to use the InnoDB engine, because some of the test cases
 280 # test transaction support.
 281
 282 set stmt [::db prepare {
 283     CREATE TABLE people(
 284         idnum INTEGER PRIMARY KEY,
 285         name VARCHAR(40) NOT NULL,
 286         info INTEGER
 287     ) ENGINE=InnoDB
 288 }]
 289 set rs [$stmt execute]
 290 rename $rs {}
 291 rename $stmt {}
 292
 293 test tdbc::mysql-4.1 {execute an insert with no params} {*}{
 294     -body {
 295         set stmt [::db prepare {
 296             INSERT INTO people(idnum, name, info) values(1, 'fred', 0)
 297         }]
 298         set rs [$stmt execute]
 299         list [$rs rowcount] [$rs columns] [$rs nextrow nothing]
 300     }
 301     -result {1 {} 0}
 302     -cleanup {
 303         catch {
 304             rename $rs {}
 305             rename $stmt {}
 306             set stmt [::db prepare {
 307                 DELETE FROM people
 308             }]
 309             set rs [$stmt execute]
 310             rename $rs {}
 311             rename $stmt {}
 312         }
 313     }
 314 }
 315
 316 test tdbc::mysql-4.2 {execute an insert with variable parameters} {*}{
 317     -body {
 318         set stmt [::db prepare {
 319             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 320         }]
 321         $stmt paramtype idnum integer
 322         $stmt paramtype name varchar 40
 323         set idnum 1
 324         set name fred
 325         set rs [$stmt execute]
 326         list [$rs rowcount] [$rs columns] [$rs nextrow nothing]
 327     }
 328     -result {1 {} 0}
 329     -cleanup {
 330         catch {
 331             rename $rs {}
 332             rename $stmt {}
 333             set stmt [::db prepare {
 334                 DELETE FROM people
 335             }]
 336             set rs [$stmt execute]
 337             rename $rs {}
 338             rename $stmt {}
 339         }
 340     }
 341 }
 342
 343 test tdbc::mysql-4.3 {execute an insert with dictionary parameters} {*}{
 344     -body {
 345         set stmt [::db prepare {
 346             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 347         }]
 348         $stmt paramtype idnum integer
 349         $stmt paramtype name varchar 40
 350         set rs [$stmt execute {idnum 1 name fred}]
 351         list [$rs rowcount] [$rs columns] [$rs nextrow nothing]
 352     }
 353     -result {1 {} 0}
 354     -cleanup {
 355         catch {
 356             rename $rs {}
 357             rename $stmt {}
 358             set stmt [::db prepare {
 359                 DELETE FROM people
 360             }]
 361             set rs [$stmt execute]
 362             rename $rs {}
 363             rename $stmt {}
 364         }
 365     }
 366 }
 367
 368 test tdbc::mysql-4.4 {bad dictionary} {*}{
 369     -body {
 370         set stmt [::db prepare {
 371             INSERT INTO people(idnum, name) values(:idnum, :name)
 372         }]
 373         $stmt paramtype idnum integer
 374         $stmt paramtype name varchar 40
 375         $stmt execute {idnum 1 name}
 376     }
 377     -returnCodes error
 378     -result {missing value to go with key}
 379     -cleanup {
 380         catch {
 381             rename $stmt {}
 382             set stmt [::db prepare {
 383                 DELETE FROM people
 384             }]
 385             set rs [$stmt execute]
 386             rename $rs {}
 387             rename $stmt {}
 388         }
 389     }
 390 }
 391
 392 test tdbc::mysql-4.5 {missing parameter variable} {*}{
 393     -constraints !sqlite
 394     -setup {
 395         catch {unset idnum}
 396     }
 397     -body {
 398         set stmt [::db prepare {
 399             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 400         }]
 401         $stmt paramtype idnum integer
 402         $stmt paramtype name varchar 40
 403         set name fred
 404         $stmt execute
 405     }
 406     -returnCodes error
 407     -match glob
 408     -result {*cannot be [nN]ull*}
 409     -cleanup {
 410         catch {
 411             rename $stmt {}
 412             set stmt [::db prepare {
 413                 DELETE FROM people
 414             }]
 415             set rs [$stmt execute]
 416             rename $rs {}
 417             rename $stmt {}
 418         }
 419     }
 420 }
 421
 422 test tdbc::mysql-4.6 {missing parameter in dictionary} {*}{
 423     -constraints !sqlite
 424     -body {
 425         set stmt [::db prepare {
 426             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 427         }]
 428         $stmt paramtype idnum integer
 429         $stmt paramtype name varchar 40
 430         $stmt execute {name fred}
 431     }
 432     -returnCodes error
 433     -match glob
 434     -result {*cannot be [nN]ull*}
 435     -cleanup {
 436         catch {
 437             rename $stmt {}
 438             set stmt [::db prepare {
 439                 DELETE FROM people
 440             }]
 441             set rs [$stmt execute]
 442             rename $rs {}
 443             rename $stmt {}
 444         }
 445     }
 446 }
 447
 448 test tdbc::mysql-4.7 {missing parameter - nullable} {*}{
 449     -setup {
 450         catch {unset info}
 451         set stmt [::db prepare {
 452             INSERT INTO people(idnum, name, info) values(:idnum, :name, :info)
 453         }]
 454         $stmt paramtype idnum integer
 455         $stmt paramtype name varchar 40
 456         $stmt paramtype info integer
 457         set stmt2 [::db prepare {
 458             SELECT name, info FROM people WHERE idnum = :idnum
 459         }]
 460         $stmt2 paramtype idnum integer
 461     }
 462     -body {
 463         set name "mr. gravel"
 464         set idnum 100
 465         set rs [$stmt execute]
 466         rename $rs {}
 467         set rs [$stmt2 execute]
 468         $rs nextrow -as dicts row
 469         set row
 470     }
 471     -result {name {mr. gravel}}
 472     -cleanup {
 473         catch {rename $rs {}}
 474         catch {
 475             rename $stmt {}
 476             rename $stmt2 {}
 477             set stmt [::db prepare {
 478                 DELETE FROM people
 479             }]
 480             set rs [$stmt execute]
 481             rename $rs {}
 482             rename $stmt {}
 483         }
 484     }
 485 }
 486
 487 test tdbc::mysql-4.8 {missing parameter in dictionary - nullable} {*}{
 488     -setup {
 489         set stmt [::db prepare {
 490             INSERT INTO people(idnum, name, info) values(:idnum, :name, :info)
 491         }]
 492         $stmt paramtype idnum integer
 493         $stmt paramtype name varchar 40
 494         $stmt paramtype info integer
 495         set stmt2 [::db prepare {
 496             SELECT name, info FROM people WHERE idnum = :idnum
 497         }]
 498         $stmt2 paramtype idnum integer
 499     }
 500     -body {
 501         set rs [$stmt execute {name {gary granite} idnum 200}]
 502         rename $rs {}
 503         set rs [$stmt2 execute {idnum 200}]
 504         $rs nextrow -as dicts row
 505         set row
 506     }
 507     -result {name {gary granite}}
 508     -cleanup {
 509         catch {rename $rs {}}
 510         catch {
 511             rename $stmt {}
 512             rename $stmt2 {}
 513             set stmt [::db prepare {
 514                 DELETE FROM people
 515             }]
 516             set rs [$stmt execute]
 517             rename $rs {}
 518             rename $stmt {}
 519         }
 520     }
 521 }
 522
 523 test tdbc::mysql-4.9 {two result sets open against the same statement} {*}{
 524     -body {
 525         set stmt [::db prepare {
 526             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 527         }]
 528         $stmt paramtype idnum integer
 529         $stmt paramtype name varchar 40
 530         set rs1 [$stmt execute {idnum 1 name fred}]
 531         set rs2 [$stmt execute {idnum 2 name wilma}]
 532         list [$rs1 rowcount] [$rs1 columns] [$rs1 nextrow nothing] \
 533             [$rs2 rowcount] [$rs2 columns] [$rs2 nextrow nothing]
 534     }
 535     -result {1 {} 0 1 {} 0}
 536     -cleanup {
 537         catch {
 538             rename $rs1 {}
 539             rename $rs2 {}
 540             rename $stmt {}
 541             set stmt [::db prepare {
 542                 DELETE FROM people
 543             }]
 544             set rs [$stmt execute]
 545             rename $rs {}
 546             rename $stmt {}
 547         }
 548     }
 549 }
 550
 551 test tdbc::mysql-4.10 {failed execution} {*}{
 552     -setup {
 553         set stmt [::db prepare {
 554             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 555         }]
 556         $stmt paramtype idnum integer
 557         $stmt paramtype name varchar 40
 558         set rs [$stmt execute {idnum 1 name fred}]
 559         rename $rs {}
 560     }
 561     -body {
 562         set status [catch {$stmt execute {idnum 1 name barney}} result]
 563         list $status $::errorCode
 564     }
 565     -cleanup {
 566         rename $stmt {}
 567         set stmt [::db prepare {
 568             DELETE FROM people
 569         }]
 570         set rs [$stmt execute]
 571         rename $rs {}
 572         rename $stmt {}
 573     }
 574     -match glob
 575     -result {1 {TDBC CONSTRAINT_VIOLATION 23* MYSQL *}}
 576 }
 577
 578 test tdbc::mysql-5.1 {paramtype - too few args} {*}{
 579     -setup {
 580         set stmt [::db prepare {
 581             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 582         }]
 583     }
 584     -body {
 585         $stmt paramtype idnum
 586     }
 587     -cleanup {
 588         rename $stmt {}
 589     }
 590     -returnCodes error
 591     -match glob
 592     -result {wrong # args*}
 593 }
 594
 595 test tdbc::mysql-5.2 {paramtype - just a direction} {*}{
 596     -setup {
 597         set stmt [::db prepare {
 598             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 599         }]
 600     }
 601     -body {
 602         $stmt paramtype idnum in
 603     }
 604     -cleanup {
 605         rename $stmt {}
 606     }
 607     -returnCodes error
 608     -match glob
 609     -result {wrong # args*}
 610 }
 611
 612 test tdbc::mysql-5.3 {paramtype - bad type} {*}{
 613     -setup {
 614         set stmt [::db prepare {
 615             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 616         }]
 617     }
 618     -body {
 619         $stmt paramtype idnum rubbish
 620     }
 621     -cleanup {
 622         rename $stmt {}
 623     }
 624     -returnCodes error
 625     -match glob
 626     -result {bad SQL data type "rubbish":*}
 627 }
 628
 629 test tdbc::mysql-5.4 {paramtype - bad scale} {*}{
 630     -setup {
 631         set stmt [::db prepare {
 632             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 633         }]
 634     }
 635     -body {
 636         $stmt paramtype idnum decimal rubbish
 637     }
 638     -cleanup {
 639         rename $stmt {}
 640     }
 641     -returnCodes error
 642     -match glob
 643     -result {expected integer but got "rubbish"}
 644 }
 645
 646 test tdbc::mysql-5.5 {paramtype - bad precision} {*}{
 647     -setup {
 648         set stmt [::db prepare {
 649             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 650         }]
 651     }
 652     -body {
 653         $stmt paramtype idnum decimal 12 rubbish
 654     }
 655     -cleanup {
 656         rename $stmt {}
 657     }
 658     -returnCodes error
 659     -match glob
 660     -result {expected integer but got "rubbish"}
 661 }
 662
 663 test tdbc::mysql-5.6 {paramtype - unknown parameter} {*}{
 664     -setup {
 665         set stmt [::db prepare {
 666             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 667         }]
 668     }
 669     -body {
 670         $stmt paramtype rubbish integer
 671     }
 672     -cleanup {
 673         rename $stmt {}
 674     }
 675     -returnCodes error
 676     -match glob
 677     -result {unknown parameter "rubbish":*}
 678 }
 679
 680 test tdbc::mysql-6.1 {rowcount - wrong args} {*}{
 681     -setup {
 682         set stmt [::db prepare {
 683             INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
 684         }]
 685         $stmt paramtype idnum integer
 686         $stmt paramtype name varchar 40
 687         set rs [$stmt execute {idnum 1 name fred}]
 688     }
 689     -body {
 690         $rs rowcount rubbish
 691     }
 692     -cleanup {
 693         rename $rs {}
 694         rename $stmt {}
 695         set stmt [::db prepare {
 696             DELETE FROM people
 697         }]
 698         set rs [$stmt execute]
 699         rename $rs {}
 700         rename $stmt {}
 701     }
 702     -returnCodes error
 703     -match glob
 704     -result "wrong \# args*"
 705 }
 706
 707 #-------------------------------------------------------------------------------
 708 #
 709 # next tests require data in the database
 710
 711 catch {
 712     set stmt [db prepare {
 713         INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
 714     }]
 715     $stmt paramtype idnum integer
 716     $stmt paramtype name varchar 40
 717     set idnum 1
 718     foreach name {fred wilma pebbles barney betty bam-bam} {
 719         set rs [$stmt execute]
 720         rename $rs {}
 721         incr idnum
 722     }
 723     rename $stmt {}
 724 }
 725
 726 #-------------------------------------------------------------------------------
 727
 728 test tdbc::mysql-7.1 {columns - bad args} {*}{
 729     -setup {
 730         set stmt [::db prepare {
 731             SELECT * FROM people
 732         }]
 733         set rs [$stmt execute]
 734     }
 735     -body {
 736         $rs columns rubbish
 737     }
 738     -cleanup {
 739         rename $rs {}
 740         rename $stmt {}
 741     }
 742     -returnCodes error
 743     -match glob
 744     -result {wrong # args*}
 745 }
 746
 747 test tdbc::mysql-7.2 {columns - get column names} {*}{
 748     -setup {
 749         set stmt [::db prepare {
 750             SELECT * FROM people
 751         }]
 752         set rs [$stmt execute]
 753     }
 754     -body {
 755         $rs columns
 756     }
 757     -cleanup {
 758         rename $rs {}
 759         rename $stmt {}
 760     }
 761     -result {idnum name info}
 762 }
 763
 764 test tdbc::mysql-8.1 {nextrow - as dicts} {*}{
 765     -setup {
 766         set stmt [::db prepare {
 767             SELECT idnum, name FROM people ORDER BY idnum
 768         }]
 769         set rs [$stmt execute]
 770     }
 771     -body {
 772         set idnum 1
 773         set names {}
 774         while {[$rs nextrow -- row]} {
 775             if {$idnum != [dict get $row idnum]} {
 776                 binary scan [dict get $row idnum] c* v; puts $v
 777                 binary scan [dict get $row name] c* v; puts $v
 778                 error [list bad idnum [dict get $row idnum] should be $idnum]
 779             }
 780             lappend names [dict get $row name]
 781             incr idnum
 782         }
 783         set names
 784     }
 785     -cleanup {
 786         rename $rs {}
 787         rename $stmt {}
 788     }
 789     -result {fred wilma pebbles barney betty bam-bam}
 790 }
 791
 792 test tdbc::mysql-8.2 {nextrow - as lists} {*}{
 793     -setup {
 794         set stmt [::db prepare {
 795             SELECT idnum, name FROM people ORDER BY idnum
 796         }]
 797         set rs [$stmt execute]
 798     }
 799     -body {
 800         set idnum 1
 801         set names {}
 802         while {[$rs nextrow -as lists -- row]} {
 803             if {$idnum != [lindex $row 0]} {
 804                 error [list bad idnum [lindex $row 0] should be $idnum]
 805             }
 806             lappend names [lindex $row 1]
 807             incr idnum
 808         }
 809         set names
 810     }
 811     -cleanup {
 812         rename $rs {}
 813         rename $stmt {}
 814     }
 815     -result {fred wilma pebbles barney betty bam-bam}
 816 }
 817
 818 test tdbc::mysql-8.3 {nextrow - bad cursor state} {*}{
 819     -setup {
 820         set stmt [::db prepare {
 821             SELECT idnum, name FROM people ORDER BY idnum
 822         }]
 823     }
 824     -body {
 825         set rs [$stmt execute]
 826         set names {}
 827         while {[$rs nextrow row]} {}
 828         $rs nextrow row
 829     }
 830     -cleanup {
 831         rename $rs {}
 832         rename $stmt {}
 833     }
 834     -result 0
 835 }
 836
 837 test tdbc::mysql-8.4 {anonymous columns - dicts} {*}{
 838     -setup {
 839         set stmt [::db prepare {
 840             SELECT COUNT(*), MAX(idnum) FROM people
 841         }]
 842         set rs [$stmt execute]
 843     }
 844     -body {
 845         list \
 846             [$rs nextrow row] \
 847             $row \
 848             [$rs nextrow row]
 849     }
 850     -cleanup {
 851         $stmt close
 852     }
 853     -match glob
 854     -result {1 {* 6 * 6} 0}
 855 };
 856
 857 test tdbc::mysql-8.5 {anonymous columns - lists} {*}{
 858     -setup {
 859         set stmt [::db prepare {
 860             SELECT COUNT(*), MAX(idnum) FROM people
 861         }]
 862         set rs [$stmt execute]
 863     }
 864     -body {
 865         list [$rs nextrow -as lists row] \
 866             $row \
 867             [$rs nextrow -as lists row]
 868     }
 869     -cleanup {
 870         $stmt close
 871     }
 872     -result {1 {6 6} 0}
 873 };
 874
 875 test tdbc::mysql-8.6 {null results - dicts} {*}{
 876     -setup {
 877         set stmt [::db prepare {
 878             SELECT idnum, name, info FROM people WHERE name = 'fred'
 879         }]
 880         set rs [$stmt execute]
 881     }
 882     -body {
 883         list [$rs nextrow row] $row [$rs nextrow row]
 884     }
 885     -cleanup {
 886         $stmt close
 887     }
 888     -result {1 {idnum 1 name fred} 0}
 889 }
 890
 891 test tdbc::mysql-8.7 {null results - lists} {*}{
 892     -setup {
 893         set stmt [::db prepare {
 894             SELECT idnum, name, info FROM people WHERE name = 'fred'
 895         }]
 896         set rs [$stmt execute]
 897     }
 898     -body {
 899         list [$rs nextrow -as lists -- row] $row [$rs nextrow -as lists -- row]
 900     }
 901     -cleanup {
 902         $stmt close
 903     }
 904     -result {1 {1 fred {}} 0}
 905 }
 906
 907 test tdbc::mysql-9.1 {rs foreach var script} {*}{
 908     -setup {
 909         set stmt [::db prepare {
 910             SELECT idnum, name FROM people WHERE name LIKE 'b%'
 911         }]
 912         set rs [$stmt execute]
 913     }
 914     -body {
 915         set result {}
 916         $rs foreach row {
 917             lappend result $row
 918         }
 919         set result
 920     }
 921     -cleanup {
 922         $rs close
 923         $stmt close
 924     }
 925     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
 926 }
 927
 928 test tdbc::mysql-9.2 {stmt foreach var script} {*}{
 929     -setup {
 930         set stmt [::db prepare {
 931             SELECT idnum, name FROM people WHERE name LIKE 'b%'
 932         }]
 933
 934     }
 935     -body {
 936         set result {}
 937         $stmt foreach row {
 938             lappend result $row
 939         }
 940         set result
 941     }
 942     -cleanup {
 943         $stmt close
 944     }
 945     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
 946 }
 947
 948 test tdbc::mysql-9.3 {db foreach var sqlcode script} {*}{
 949     -body {
 950         set result {}
 951         db foreach row {
 952             SELECT idnum, name FROM people WHERE name LIKE 'b%'
 953         } {
 954             lappend result $row
 955         }
 956         set result
 957     }
 958     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
 959 }
 960
 961 test tdbc::mysql-9.4 {rs foreach -- var script} {*}{
 962     -setup {
 963         set stmt [::db prepare {
 964             SELECT idnum, name FROM people WHERE name LIKE 'b%'
 965         }]
 966         set rs [$stmt execute]
 967     }
 968     -body {
 969         set result {}
 970         $rs foreach -- row {
 971             lappend result $row
 972         }
 973         set result
 974     }
 975     -cleanup {
 976         $rs close
 977         $stmt close
 978     }
 979     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
 980 }
 981
 982 test tdbc::mysql-9.5 {stmt foreach -- var script} {*}{
 983     -setup {
 984         set stmt [::db prepare {
 985             SELECT idnum, name FROM people WHERE name LIKE 'b%'
 986         }]
 987     }
 988     -body {
 989         set result {}
 990         $stmt foreach -- row {
 991             lappend result $row
 992         }
 993         set result
 994     }
 995     -cleanup {
 996         $stmt close
 997     }
 998     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
 999 }
1000
1001 test tdbc::mysql-9.6 {db foreach -- var query script} {*}{
1002     -body {
1003         set result {}
1004         db foreach -- row {
1005             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1006         } {
1007             lappend result $row
1008         }
1009         set result
1010     }
1011     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1012 }
1013
1014 test tdbc::mysql-9.7 {rs foreach -- -as lists} {*}{
1015     -setup {
1016         set stmt [::db prepare {
1017             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1018         }]
1019         set rs [$stmt execute]
1020     }
1021     -body {
1022         set result {}
1023         $rs foreach -as lists row {
1024             lappend result $row
1025         }
1026         set result
1027     }
1028     -cleanup {
1029         $rs close
1030         $stmt close
1031     }
1032     -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1033 }
1034
1035 test tdbc::mysql-9.8 {stmt foreach -as lists} {*}{
1036     -setup {
1037         set stmt [::db prepare {
1038             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1039         }]
1040     }
1041     -body {
1042         set result {}
1043         $stmt foreach -as lists row {
1044             lappend result $row
1045         }
1046         set result
1047     }
1048     -cleanup {
1049         $stmt close
1050     }
1051     -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1052 }
1053
1054 test tdbc::mysql-9.9 {db foreach -as lists} {*}{
1055     -body {
1056         set result {}
1057         db foreach -as lists row {
1058             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1059         } {
1060             lappend result $row
1061         }
1062         set result
1063     }
1064     -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1065 }
1066
1067 test tdbc::mysql-9.10 {rs foreach -as lists --} {*}{
1068     -setup {
1069         set stmt [::db prepare {
1070             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1071         }]
1072         set rs [$stmt execute]
1073     }
1074     -body {
1075         set result {}
1076         $rs foreach -as lists -- row {
1077             lappend result $row
1078         }
1079         set result
1080     }
1081     -cleanup {
1082         $rs close
1083         $stmt close
1084     }
1085     -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1086 }
1087
1088 test tdbc::mysql-9.11 {stmt foreach -as lists --} {*}{
1089     -setup {
1090         set stmt [::db prepare {
1091             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1092         }]
1093     }
1094     -body {
1095         set result {}
1096         $stmt foreach -as lists -- row {
1097             lappend result $row
1098         }
1099         set result
1100     }
1101     -cleanup {
1102         $stmt close
1103     }
1104     -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1105 }
1106
1107 test tdbc::mysql-9.12 {db foreach -as lists --} {*}{
1108     -body {
1109         set result {}
1110         db foreach -as lists row {
1111             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1112         } {
1113             lappend result $row
1114         }
1115         set result
1116     }
1117     -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}}
1118 }
1119
1120 test tdbc::mysql-9.13 {rs foreach -as lists -columnsvar c --} {*}{
1121     -setup {
1122         set stmt [::db prepare {
1123             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1124         }]
1125         set rs [$stmt execute]
1126     }
1127     -body {
1128         set result {}
1129         $rs foreach -as lists -columnsvar c -- row {
1130             foreach cn $c cv $row {
1131                 lappend result $cn $cv
1132             }
1133         }
1134         set result
1135     }
1136     -cleanup {
1137         $rs close
1138         $stmt close
1139     }
1140     -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam}
1141 }
1142
1143 test tdbc::mysql-9.14 {stmt foreach -as lists -columnsvar c --} {*}{
1144     -setup {
1145         set stmt [::db prepare {
1146             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1147         }]
1148     }
1149     -body {
1150         set result {}
1151         $stmt foreach -as lists -columnsvar c -- row {
1152             foreach cn $c cv $row {
1153                 lappend result $cn $cv
1154             }
1155         }
1156         set result
1157     }
1158     -cleanup {
1159         $stmt close
1160     }
1161     -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam}
1162 }
1163
1164 test tdbc::mysql-9.15 {db foreach -as lists -columnsvar c --} {*}{
1165     -body {
1166         set result {}
1167         db foreach -as lists -columnsvar c -- row {
1168             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1169         } {
1170             foreach cn $c cv $row {
1171                 lappend result $cn $cv
1172             }
1173         }
1174         set result
1175     }
1176     -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam}
1177 }
1178
1179 test tdbc::mysql-9.16 {rs foreach / break out of loop} {*}{
1180     -setup {
1181         set stmt [::db prepare {
1182             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1183         }]
1184         set rs [$stmt execute]
1185     }
1186     -body {
1187         set result {}
1188         $rs foreach -as lists -- row {
1189             if {[lindex $row 1] eq {betty}} break
1190             lappend result $row
1191         }
1192         set result
1193     }
1194     -cleanup {
1195         $rs close
1196         $stmt close
1197     }
1198     -result {{4 barney {}}}
1199 }
1200
1201 test tdbc::mysql-9.17 {stmt foreach / break out of loop} {*}{
1202     -setup {
1203         set stmt [::db prepare {
1204             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1205         }]
1206     }
1207     -body {
1208         set result {}
1209         $stmt foreach -as lists -- row {
1210             if {[lindex $row 1] eq {betty}} break
1211             lappend result $row
1212         }
1213         set result
1214     }
1215     -cleanup {
1216         $stmt close
1217     }
1218     -result {{4 barney {}}}
1219 }
1220
1221 test tdbc::mysql-9.18 {db foreach / break out of loop} {*}{
1222     -body {
1223         set result {}
1224         db foreach -as lists -- row {
1225             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1226         } {
1227             if {[lindex $row 1] eq {betty}} break
1228             lappend result $row
1229         }
1230         set result
1231     }
1232     -result {{4 barney {}}}
1233 }
1234
1235 test tdbc::mysql-9.19 {rs foreach / continue in loop} {*}{
1236     -setup {
1237         set stmt [::db prepare {
1238             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1239         }]
1240         set rs [$stmt execute]
1241     }
1242     -body {
1243         set result {}
1244         $rs foreach -as lists -- row {
1245             if {[lindex $row 1] eq {betty}} continue
1246             lappend result $row
1247         }
1248         set result
1249     }
1250     -cleanup {
1251         $rs close
1252         $stmt close
1253     }
1254     -result {{4 barney {}} {6 bam-bam {}}}
1255 }
1256
1257 test tdbc::mysql-9.20 {stmt foreach / continue in loop} {*}{
1258     -setup {
1259         set stmt [::db prepare {
1260             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1261         }]
1262     }
1263     -body {
1264         set result {}
1265         $stmt foreach -as lists -- row {
1266             if {[lindex $row 1] eq {betty}} continue
1267             lappend result $row
1268         }
1269         set result
1270     }
1271     -cleanup {
1272         $stmt close
1273     }
1274     -result {{4 barney {}} {6 bam-bam {}}}
1275 }
1276
1277 test tdbc::mysql-9.21 {db foreach / continue in loop} {*}{
1278     -body {
1279         set result {}
1280         db foreach -as lists -- row {
1281             SELECT idnum, name, info FROM people WHERE name LIKE 'b%'
1282         } {
1283             if {[lindex $row 1] eq {betty}} continue
1284             lappend result $row
1285         }
1286         set result
1287     }
1288     -result {{4 barney {}} {6 bam-bam {}}}
1289 }
1290
1291 test tdbc::mysql-9.22 {rs foreach / return out of the loop} {*}{
1292     -setup {
1293         set stmt [::db prepare {
1294             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1295         }]
1296         set rs [$stmt execute]
1297         proc tdbcmysql-9.22 {rs} {
1298             $rs foreach -as lists -- row {
1299                 if {[lindex $row 1] eq {betty}} {
1300                     return [lindex $row 0]
1301                 }
1302             }
1303             return failed
1304         }
1305     }
1306     -body {
1307         tdbcmysql-9.22 $rs
1308     }
1309     -cleanup {
1310         rename tdbcmysql-9.22 {}
1311         rename $rs {}
1312         rename $stmt {}
1313     }
1314     -result 5
1315 }
1316
1317 test tdbc::mysql-9.23 {stmt foreach / return out of the loop} {*}{
1318     -setup {
1319         set stmt [::db prepare {
1320             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1321         }]
1322         proc tdbcmysql-9.23 {stmt} {
1323             $stmt foreach -as lists -- row {
1324                 if {[lindex $row 1] eq {betty}} {
1325                     return [lindex $row 0]
1326                 }
1327             }
1328             return failed
1329         }
1330     }
1331     -body {
1332         tdbcmysql-9.23 $stmt
1333     }
1334     -cleanup {
1335         rename tdbcmysql-9.23 {}
1336         rename $stmt {}
1337     }
1338     -result 5
1339 }
1340
1341 test tdbc::mysql-9.24 {db foreach / return out of the loop} {*}{
1342     -setup {
1343         proc tdbcmysql-9.24 {stmt} {
1344             db foreach -as lists -- row {
1345                 SELECT idnum, name FROM people WHERE name LIKE 'b%'
1346             } {
1347                 if {[lindex $row 1] eq {betty}} {
1348                     return [lindex $row 0]
1349                 }
1350             }
1351             return failed
1352         }
1353     }
1354     -body {
1355         tdbcmysql-9.24 $stmt
1356     }
1357     -cleanup {
1358         rename tdbcmysql-9.24 {}
1359     }
1360     -result 5
1361 }
1362
1363 test tdbc::mysql-9.25 {rs foreach / error out of the loop} {*}{
1364     -setup {
1365         set stmt [::db prepare {
1366             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1367         }]
1368         set rs [$stmt execute]
1369         proc tdbcmysql-9.25 {rs} {
1370             $rs foreach -as lists -- row {
1371                 if {[lindex $row 1] eq {betty}} {
1372                     error [lindex $row 0]
1373                 }
1374             }
1375             return failed
1376         }
1377     }
1378     -body {
1379         tdbcmysql-9.25 $rs
1380     }
1381     -cleanup {
1382         rename tdbcmysql-9.25 {}
1383         rename $rs {}
1384         rename $stmt {}
1385     }
1386     -returnCodes error
1387     -result 5
1388 }
1389
1390 test tdbc::mysql-9.26 {stmt foreach - error out of the loop} {*}{
1391     -setup {
1392         set stmt [::db prepare {
1393             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1394         }]
1395         proc tdbcmysql-9.26 {stmt} {
1396             $stmt foreach -as lists -- row {
1397                 if {[lindex $row 1] eq {betty}} {
1398                     error [lindex $row 0]
1399                 }
1400             }
1401             return failed
1402         }
1403     }
1404     -body {
1405         tdbcmysql-9.26 $stmt
1406     }
1407     -cleanup {
1408         rename tdbcmysql-9.26 {}
1409         rename $stmt {}
1410     }
1411     -returnCodes error
1412     -result 5
1413 }
1414
1415 test tdbc::mysql-9.27 {db foreach / error out of the loop} {*}{
1416     -setup {
1417         proc tdbcmysql-9.27 {} {
1418             db foreach -as lists -- row {
1419                 SELECT idnum, name FROM people WHERE name LIKE 'b%'
1420             } {
1421                 if {[lindex $row 1] eq {betty}} {
1422                     error [lindex $row 0]
1423                 }
1424             }
1425             return failed
1426         }
1427     }
1428     -body {
1429         tdbcmysql-9.27
1430     }
1431     -cleanup {
1432         rename tdbcmysql-9.27 {}
1433     }
1434     -returnCodes error
1435     -result 5
1436 }
1437
1438 test tdbc::mysql-9.28 {rs foreach / unknown status from the loop} {*}{
1439     -setup {
1440         set stmt [::db prepare {
1441             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1442         }]
1443         set rs [$stmt execute]
1444         proc tdbcmysql-9.28 {rs} {
1445             $rs foreach -as lists -- row {
1446                 if {[lindex $row 1] eq {betty}} {
1447                     return -code 666 -level 0 [lindex $row 0]
1448                 }
1449             }
1450             return failed
1451         }
1452     }
1453     -body {
1454         tdbcmysql-9.28 $rs
1455     }
1456     -cleanup {
1457         rename tdbcmysql-9.28 {}
1458         rename $rs {}
1459         rename $stmt {}
1460     }
1461     -returnCodes 666
1462     -result 5
1463 }
1464
1465 test tdbc::mysql-9.29 {stmt foreach / unknown status from the loop} {*}{
1466     -setup {
1467         set stmt [::db prepare {
1468             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1469         }]
1470         proc tdbcmysql-9.29 {stmt} {
1471             $stmt foreach -as lists -- row {
1472                 if {[lindex $row 1] eq {betty}} {
1473                     return -code 666 -level 0 [lindex $row 0]
1474                 }
1475             }
1476             return failed
1477         }
1478     }
1479     -body {
1480         tdbcmysql-9.29 $stmt
1481     }
1482     -cleanup {
1483         rename tdbcmysql-9.29 {}
1484         rename $stmt {}
1485     }
1486     -returnCodes 666
1487     -result 5
1488 }
1489
1490 test tdbc::mysql-9.30 {db foreach / unknown status from the loop} {*}{
1491     -setup {
1492         proc tdbcmysql-9.30 {stmt} {
1493             db foreach -as lists -- row {
1494                 SELECT idnum, name FROM people WHERE name LIKE 'b%'
1495             } {
1496                 if {[lindex $row 1] eq {betty}} {
1497                     return -code 666 -level 0 [lindex $row 0]
1498                 }
1499             }
1500             return failed
1501         }
1502     }
1503     -body {
1504         tdbcmysql-9.30 $stmt
1505     }
1506     -cleanup {
1507         rename tdbcmysql-9.30 {}
1508     }
1509     -returnCodes 666
1510     -result 5
1511 }
1512
1513 test tdbc::mysql-9.31 {stmt foreach / params in variables} {*}{
1514     -setup {
1515         set stmt [::db prepare {
1516             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1517         }]
1518         $stmt paramtype thePattern varchar 40
1519     }
1520     -body {
1521         set result {}
1522         set thePattern b%
1523         $stmt foreach row {
1524             lappend result $row
1525         }
1526         set result
1527     }
1528     -cleanup {
1529         $stmt close
1530     }
1531     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1532 }
1533
1534 test tdbc::mysql-9.32 {db foreach / params in variables} {*}{
1535     -body {
1536         set result {}
1537         set thePattern b%
1538         db foreach row {
1539             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1540         } {
1541             lappend result $row
1542         }
1543         set result
1544     }
1545     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1546 }
1547
1548 test tdbc::mysql-9.33 {stmt foreach / parameters in a dictionary} {*}{
1549     -setup {
1550         set stmt [::db prepare {
1551             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1552         }]
1553         $stmt paramtype thePattern varchar 40
1554     }
1555     -body {
1556         set result {}
1557         $stmt foreach row {thePattern b%} {
1558             lappend result $row
1559         }
1560         set result
1561     }
1562     -cleanup {
1563         $stmt close
1564     }
1565     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1566 }
1567
1568 test tdbc::mysql-9.34 {db foreach / parameters in a dictionary} {*}{
1569     -body {
1570         set result {}
1571         db foreach row {
1572             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1573         } {thePattern b%} {
1574             lappend result $row
1575         }
1576         set result
1577     }
1578     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1579 }
1580
1581 test tdbc::mysql-9.35 {stmt foreach - variable not found} {*}{
1582     -setup {
1583         set stmt [::db prepare {
1584             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1585         }]
1586         $stmt paramtype thePattern varchar 40
1587         catch {unset thePattern}
1588     }
1589     -body {
1590         set result {}
1591         set thePattern(bogosity) {}
1592         $stmt foreach row {
1593             lappend result $row
1594         }
1595         set result
1596     }
1597     -cleanup {
1598         unset thePattern
1599         $stmt close
1600     }
1601     -result {}
1602 }
1603
1604 test tdbc::mysql-9.36 {db foreach - variable not found} {*}{
1605     -setup {
1606         catch {unset thePattern}
1607     }
1608     -body {
1609         set result {}
1610         set thePattern(bogosity) {}
1611         db foreach row {
1612             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1613         } {
1614             lappend result $row
1615         }
1616         set result
1617     }
1618     -cleanup {
1619         unset thePattern
1620     }
1621     -result {}
1622 }
1623
1624 test tdbc::mysql-9.37 {rs foreach - too few args} {*}{
1625     -setup {
1626         set stmt [::db prepare {
1627             SELECT idnum, name FROM people
1628         }]
1629         set rs [$stmt execute]
1630     }
1631     -body {
1632         $rs foreach row
1633     }
1634     -cleanup {
1635         $rs close
1636         $stmt close
1637     }
1638     -returnCodes error
1639     -result {wrong # args*}
1640     -match glob
1641 }
1642
1643 test tdbc::mysql-9.38 {stmt foreach - too few args} {*}{
1644     -setup {
1645         set stmt [::db prepare {
1646             SELECT idnum, name FROM people
1647         }]
1648     }
1649     -body {
1650         $stmt foreach row
1651     }
1652     -cleanup {
1653         $stmt close
1654     }
1655     -returnCodes error
1656     -result {wrong # args*}
1657     -match glob
1658 }
1659
1660 test tdbc::mysql-9.39 {db foreach - too few args} {*}{
1661     -body {
1662         db foreach row {
1663             SELECT idnum, name FROM people
1664         }
1665     }
1666     -returnCodes error
1667     -result {wrong # args*}
1668     -match glob
1669 }
1670
1671 test tdbc::mysql-9.40 {rs foreach - too many args} {*}{
1672     -setup {
1673         set stmt [::db prepare {
1674             SELECT idnum, name FROM people
1675         }]
1676         set rs [$stmt execute]
1677     }
1678     -body {
1679         $rs foreach row do something
1680     }
1681     -cleanup {
1682         $rs close
1683         $stmt close
1684     }
1685     -returnCodes error
1686     -result {wrong # args*}
1687     -match glob
1688 }
1689
1690 test tdbc::mysql-9.41 {stmt foreach - too many args} {*}{
1691     -setup {
1692         set stmt [::db prepare {
1693             SELECT idnum, name FROM people
1694         }]
1695     }
1696     -body {
1697         $stmt foreach row do something else
1698     }
1699     -cleanup {
1700         $stmt close
1701     }
1702     -returnCodes error
1703     -result {wrong # args*}
1704     -match glob
1705 }
1706
1707 test tdbc::mysql-9.42 {db foreach - too many args} {*}{
1708     -body {
1709         db foreach row {
1710             SELECT idnum, name FROM people
1711         } {} do something
1712     }
1713     -returnCodes error
1714     -result {wrong # args*}
1715     -match glob
1716 }
1717
1718 test tdbc::mysql-10.1 {allrows - no args} {*}{
1719     -setup {
1720         set stmt [::db prepare {
1721             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1722         }]
1723         set rs [$stmt execute]
1724     }
1725     -body {
1726         $rs allrows
1727     }
1728     -cleanup {
1729         rename $rs {}
1730         rename $stmt {}
1731     }
1732     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1733 }
1734
1735 test tdbc::mysql-10.2 {allrows - no args} {*}{
1736     -setup {
1737         set stmt [::db prepare {
1738             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1739         }]
1740     }
1741     -body {
1742         $stmt allrows
1743     }
1744     -cleanup {
1745         rename $stmt {}
1746     }
1747     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1748 }
1749
1750 test tdbc::mysql-10.3 {allrows - no args} {*}{
1751     -body {
1752         db allrows {
1753             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1754         }
1755     }
1756     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1757 }
1758
1759 test tdbc::mysql-10.4 {allrows --} {*}{
1760     -setup {
1761         set stmt [::db prepare {
1762             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1763         }]
1764         set rs [$stmt execute]
1765     }
1766     -body {
1767         $rs allrows --
1768     }
1769     -cleanup {
1770         rename $rs {}
1771         rename $stmt {}
1772     }
1773     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1774 }
1775
1776 test tdbc::mysql-10.5 {allrows --} {*}{
1777     -setup {
1778         set stmt [::db prepare {
1779             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1780         }]
1781     }
1782     -body {
1783         $stmt allrows --
1784     }
1785     -cleanup {
1786         rename $stmt {}
1787     }
1788     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1789 }
1790
1791 test tdbc::mysql-10.6 {allrows --} {*}{
1792     -body {
1793         db allrows -- {
1794             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1795         }
1796     }
1797     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1798 }
1799
1800 test tdbc::mysql-10.7 {allrows -as lists} {*}{
1801     -setup {
1802         set stmt [::db prepare {
1803             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1804         }]
1805         set rs [$stmt execute]
1806     }
1807     -body {
1808         $rs allrows -as lists
1809     }
1810     -cleanup {
1811         rename $rs {}
1812         rename $stmt {}
1813     }
1814     -result {{4 barney} {5 betty} {6 bam-bam}}
1815 }
1816
1817 test tdbc::mysql-10.8 {allrows -as lists} {*}{
1818     -setup {
1819         set stmt [::db prepare {
1820             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1821         }]
1822     }
1823     -body {
1824         $stmt allrows -as lists
1825     }
1826     -cleanup {
1827         rename $stmt {}
1828     }
1829     -result {{4 barney} {5 betty} {6 bam-bam}}
1830 }
1831
1832 test tdbc::mysql-10.9 {allrows -as lists} {*}{
1833     -body {
1834         db allrows -as lists {
1835             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1836         }
1837     }
1838     -result {{4 barney} {5 betty} {6 bam-bam}}
1839 }
1840
1841 test tdbc::mysql-10.10 {allrows -as lists --} {*}{
1842     -setup {
1843         set stmt [::db prepare {
1844             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1845         }]
1846         set rs [$stmt execute]
1847     }
1848     -body {
1849         $rs allrows -as lists --
1850     }
1851     -cleanup {
1852         rename $rs {}
1853         rename $stmt {}
1854     }
1855     -result {{4 barney} {5 betty} {6 bam-bam}}
1856 }
1857
1858 test tdbc::mysql-10.11 {allrows -as lists --} {*}{
1859     -setup {
1860         set stmt [::db prepare {
1861             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1862         }]
1863     }
1864     -body {
1865         $stmt allrows -as lists --
1866     }
1867     -cleanup {
1868         rename $stmt {}
1869     }
1870     -result {{4 barney} {5 betty} {6 bam-bam}}
1871 }
1872
1873 test tdbc::mysql-10.12 {allrows -as lists --} {*}{
1874     -body {
1875         db allrows -as lists -- {
1876             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1877         }
1878     }
1879     -result {{4 barney} {5 betty} {6 bam-bam}}
1880 }
1881
1882 test tdbc::mysql-10.13 {allrows -as lists -columnsvar c} {*}{
1883     -setup {
1884         set stmt [::db prepare {
1885             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1886         }]
1887         set rs [$stmt execute]
1888     }
1889     -body {
1890         set result [$rs allrows -as lists -columnsvar c]
1891         list $c $result
1892     }
1893     -cleanup {
1894         rename $rs {}
1895         rename $stmt {}
1896     }
1897     -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}}
1898 }
1899
1900 test tdbc::mysql-10.14 {allrows -as lists -columnsvar c} {*}{
1901     -setup {
1902         set stmt [::db prepare {
1903             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1904         }]
1905     }
1906     -body {
1907         set result [$stmt allrows -as lists -columnsvar c]
1908         list $c $result
1909     }
1910     -cleanup {
1911         rename $stmt {}
1912     }
1913     -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}}
1914 }
1915
1916 test tdbc::mysql-10.15 {allrows -as lists -columnsvar c} {*}{
1917     -body {
1918         set result [db allrows -as lists -columnsvar c {
1919             SELECT idnum, name FROM people WHERE name LIKE 'b%'
1920         }]
1921         list $c $result
1922     }
1923     -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}}
1924 }
1925
1926 test tdbc::mysql-10.16 {allrows - correct lexical scoping of variables} {*}{
1927     -setup {
1928         set stmt [::db prepare {
1929             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1930         }]
1931         $stmt paramtype thePattern varchar 40
1932     }
1933     -body {
1934         set thePattern b%
1935         $stmt allrows
1936     }
1937     -cleanup {
1938         $stmt close
1939     }
1940     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1941 }
1942
1943 test tdbc::mysql-10.17 {allrows - parameters in a dictionary} {*}{
1944     -setup {
1945         set stmt [::db prepare {
1946             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1947         }]
1948         $stmt paramtype thePattern varchar 40
1949     }
1950     -body {
1951         $stmt allrows {thePattern b%}
1952     }
1953     -cleanup {
1954         $stmt close
1955     }
1956     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1957 }
1958
1959 test tdbc::mysql-10.18 {allrows - parameters in a dictionary} {*}{
1960     -body {
1961         db allrows {
1962             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1963         } {thePattern b%}
1964     }
1965     -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
1966 }
1967
1968 test tdbc::mysql-10.19 {allrows - variable not found} {*}{
1969     -setup {
1970         catch {unset thePattern}
1971     }
1972     -body {
1973         set thePattern(bogosity) {}
1974         db allrows {
1975             SELECT idnum, name FROM people WHERE name LIKE :thePattern
1976         }
1977     }
1978     -cleanup {
1979         unset thePattern
1980     }
1981     -result {}
1982 }
1983
1984 test tdbc::mysql-10.20 {allrows - too many args} {*}{
1985     -setup {
1986         set stmt [::db prepare {
1987             SELECT idnum, name FROM people
1988         }]
1989     }
1990     -body {
1991         $stmt allrows {} rubbish
1992     }
1993     -cleanup {
1994         $stmt close
1995     }
1996     -returnCodes error
1997     -result {wrong # args*}
1998     -match glob
1999 }
2000
2001 test tdbc::mysql-10.21 {bad -as} {*}{
2002     -body {
2003         db allrows -as trash {
2004             SELECT idnum, name FROM people
2005         }
2006     }
2007     -returnCodes error
2008     -result {bad variable type "trash": must be lists or dicts}
2009 }
2010
2011 test tdbc::mysql-11.1 {update - no rows} {*}{
2012     -setup {
2013         set stmt [::db prepare {
2014             UPDATE people SET info = 1 WHERE idnum > 6
2015         }]
2016         set rs [$stmt execute]
2017     }
2018     -body {
2019         $rs rowcount
2020     }
2021     -cleanup {
2022         rename $rs {}
2023         rename $stmt {}
2024     }
2025     -result 0
2026 }
2027
2028 test tdbc::mysql-11.2 {update - unique row} {*}{
2029     -setup {
2030         set stmt [::db prepare {
2031             UPDATE people SET info = 1 WHERE name = 'fred'
2032         }]
2033     }
2034     -body {
2035         set rs [$stmt execute]
2036         $rs rowcount
2037     }
2038     -cleanup {
2039         rename $rs {}
2040         rename $stmt {}
2041     }
2042     -result 1
2043 }
2044
2045 test tdbc::mysql-11.3 {update - multiple rows} {*}{
2046     -setup {
2047         set stmt [::db prepare {
2048             UPDATE people SET info = 1 WHERE name LIKE 'b%'
2049         }]
2050     }
2051     -body {
2052         set rs [$stmt execute]
2053         $rs rowcount
2054     }
2055     -cleanup {
2056         rename $rs {}
2057         rename $stmt {}
2058     }
2059     -result 3
2060 }
2061
2062 test tdbc::mysql-12.1 {delete - no rows} {*}{
2063     -setup {
2064         set stmt [::db prepare {
2065             DELETE FROM people WHERE name = 'nobody'
2066         }]
2067     }
2068     -body {
2069         set rs [$stmt execute]
2070         $rs rowcount
2071     }
2072     -cleanup {
2073         rename $rs {}
2074         rename $stmt {}
2075     }
2076     -result 0
2077 }
2078
2079 test tdbc::mysql-12.2 {delete - unique row} {*}{
2080     -setup {
2081         set stmt [::db prepare {
2082             DELETE FROM people WHERE name = 'fred'
2083         }]
2084     }
2085     -body {
2086         set rs [$stmt execute]
2087         $rs rowcount
2088     }
2089     -cleanup {
2090         rename $rs {}
2091         rename $stmt {}
2092     }
2093     -result 1
2094 }
2095
2096 test tdbc::mysql-12.3 {delete - multiple rows} {*}{
2097     -setup {
2098         set stmt [::db prepare {
2099             DELETE FROM people WHERE name LIKE 'b%'
2100         }]
2101     }
2102     -body {
2103         set rs [$stmt execute]
2104         $rs rowcount
2105     }
2106     -cleanup {
2107         rename $rs {}
2108         rename $stmt {}
2109     }
2110     -result 3
2111 }
2112
2113 test tdbc::mysql-13.1 {resultsets - no results} {*}{
2114     -setup {
2115         set stmt [::db prepare {
2116             SELECT name FROM people WHERE idnum = $idnum
2117         }]
2118     }
2119     -body {
2120         list \
2121             [llength [$stmt resultsets]] \
2122             [llength [::db resultsets]]
2123     }
2124     -cleanup {
2125         rename $stmt {}
2126     }
2127     -result {0 0}
2128 }
2129
2130 test tdbc::mysql-13.2 {resultsets - various statements and results} {*}{
2131     -setup {
2132         for {set i 0} {$i < 6} {incr i} {
2133             set stmts($i) [::db prepare {
2134                 SELECT name FROM people WHERE idnum = :idnum
2135             }]
2136             $stmts($i) paramtype idnum integer
2137             for {set j 0} {$j < $i} {incr j} {
2138                 set resultsets($i,$j) [$stmts($i) execute [list idnum $j]]
2139             }
2140             for {set j 1} {$j < $i} {incr j 2} {
2141                 $resultsets($i,$j) close
2142                 unset resultsets($i,$j)
2143             }
2144         }
2145     }
2146     -body {
2147         set x [list [llength [::db resultsets]]]
2148         for {set i 0} {$i < 6} {incr i} {
2149             lappend x [llength [$stmts($i) resultsets]]
2150         }
2151         set x
2152     }
2153     -cleanup {
2154         for {set i 0} {$i < 6} {incr i} {
2155             $stmts($i) close
2156         }
2157     }
2158     -result {9 0 1 1 2 2 3}
2159 }
2160
2161 #-------------------------------------------------------------------------------
2162 #
2163 # next tests require a fresh database connection.  Close the existing one down
2164
2165 catch {
2166     set stmt [db prepare {
2167         DELETE FROM people
2168     }]
2169     $stmt execute
2170 }
2171 catch {
2172     rename ::db {}
2173 }
2174
2175 tdbc::mysql::connection create ::db {*}$::connFlags
2176 catch {
2177     set stmt [db prepare {
2178         INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
2179     }]
2180     $stmt paramtype idnum integer
2181     $stmt paramtype name varchar 40
2182     set idnum 1
2183     foreach name {fred wilma pebbles barney betty bam-bam} {
2184         set rs [$stmt execute]
2185         rename $rs {}
2186         incr idnum
2187     }
2188     rename $stmt {}
2189 }
2190
2191 test tdbc::mysql-14.1 {begin transaction - wrong # args} {*}{
2192     -body {
2193         ::db begintransaction junk
2194     }
2195     -returnCodes error
2196     -match glob
2197     -result {wrong # args*}
2198 }
2199
2200 test tdbc::mysql-14.2 {commit - wrong # args} {*}{
2201     -body {
2202         ::db commit junk
2203     }
2204     -returnCodes error
2205     -match glob
2206     -result {wrong # args*}
2207 }
2208
2209 test tdbc::mysql-14.3 {rollback - wrong # args} {*}{
2210     -body {
2211         ::db rollback junk
2212     }
2213     -returnCodes error
2214     -match glob
2215     -result {wrong # args*}
2216 }
2217
2218 test tdbc::mysql-14.4 {commit - not in transaction} {*}{
2219     -body {
2220         list [catch {::db commit} result] $result $::errorCode
2221     }
2222     -match glob
2223     -result {1 {no transaction is in progress} {TDBC GENERAL_ERROR HY010 MYSQL *}}
2224 }
2225
2226 test tdbc::mysql-14.5 {rollback - not in transaction} {*}{
2227     -body {
2228         list [catch {::db rollback} result] $result $::errorCode
2229     }
2230     -match glob
2231     -result {1 {no transaction is in progress} {TDBC GENERAL_ERROR HY010 MYSQL *}}
2232 }
2233
2234 test tdbc::mysql-14.6 {empty transaction} {*}{
2235     -body {
2236         ::db begintransaction
2237         ::db commit
2238     }
2239     -result {}
2240 }
2241
2242 test tdbc::mysql-14.7 {empty rolled-back transaction} {*}{
2243     -body {
2244         ::db begintransaction
2245         ::db rollback
2246     }
2247     -result {}
2248 }
2249
2250 test tdbc::mysql-14.8 {rollback does not change database} {*}{
2251     -body {
2252         ::db begintransaction
2253         set stmt [::db prepare {DELETE FROM people WHERE name = 'fred'}]
2254         set rs [$stmt execute]
2255         while {[$rs nextrow trash]} {}
2256         rename $rs {}
2257         rename $stmt {}
2258         ::db rollback
2259         set stmt [::db prepare {SELECT idnum FROM people WHERE name = 'fred'}]
2260         set id {changes still visible after rollback}
2261         set rs [$stmt execute]
2262         while {[$rs nextrow -as lists row]} {
2263             set id [lindex $row 0]
2264         }
2265         rename $rs {}
2266         rename $stmt {}
2267         set id
2268     }
2269     -result 1
2270 }
2271 test tdbc::mysql-14.9 {commit does change database} {*}{
2272     -setup {
2273         set stmt1 [db prepare {
2274             INSERT INTO people(idnum, name, info)
2275             VALUES(7, 'mr. gravel', 0)
2276         }]
2277         set stmt2 [db prepare {
2278             SELECT idnum FROM people WHERE name = 'mr. gravel'
2279         }]
2280     }
2281     -body {
2282         ::db begintransaction
2283         set rs [$stmt1 execute]
2284         rename $rs {}
2285         ::db commit
2286         set rs [$stmt2 execute]
2287         while {[$rs nextrow -as lists row]} {
2288             set id [lindex $row 0]
2289         }
2290         rename $rs {}
2291         set id
2292     }
2293     -cleanup {
2294         rename $stmt1 {}
2295         rename $stmt2 {}
2296     }
2297     -result 7
2298 }
2299
2300 test tdbc::mysql-14.10 {nested transactions} {*}{
2301     -body {
2302         ::db begintransaction
2303         list [catch {::db begintransaction} result] $result $::errorCode
2304     }
2305     -cleanup {
2306         catch {::db rollback}
2307     }
2308     -match glob
2309     -result {1 {MySQL does not support nested transactions} {TDBC GENERAL_ERROR HYC00 MYSQL *}}
2310 }
2311
2312 #------------------------------------------------------------------------------
2313 #
2314 # Clean up database again for the next round.
2315
2316 catch {
2317     set stmt [db prepare {
2318         DELETE FROM people
2319     }]
2320     $stmt execute
2321 }
2322 catch {
2323     rename ::db {}
2324 }
2325
2326 tdbc::mysql::connection create ::db {*}$::connFlags
2327
2328 # Things should be sane enough that we can find out the database version.
2329 # REFERENTIAL_CONSTRAINTS,REFERENCED_TABLE_COLUMN doesn't exist until 5.1.16,
2330 # and [db foreignkeys] depends on it.
2331
2332 set version unknown
2333 db foreach -as lists -- row {SELECT version()} {
2334     set version [lindex $row 0]
2335 }
2336 tcltest::testConstraint mysqlAtLeast5116 \
2337     [expr {[regexp {^\d+\.\d+(?:\.\d+)?} $version components]
2338            && [package vcompare $components 5.1.16] >= 0}]
2339
2340 catch {
2341     set stmt [db prepare {
2342         INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
2343     }]
2344     $stmt paramtype idnum integer
2345     $stmt paramtype name varchar 40
2346     set idnum 1
2347     foreach name {fred wilma pebbles barney betty bam-bam} {
2348         set rs [$stmt execute]
2349         rename $rs {}
2350         incr idnum
2351     }
2352     rename $stmt {}
2353 }
2354
2355 test tdbc::mysql-15.1 {successful (empty) transaction} {*}{
2356     -body {
2357         db transaction {
2358             concat ok
2359         }
2360     }
2361     -result ok
2362 }
2363
2364 test tdbc::mysql-15.2 {failing transaction does not get committed} {*}{
2365     -setup {
2366         set stmt1 [db prepare {
2367             DELETE FROM people WHERE name = 'fred'
2368         }]
2369         set stmt2 [db prepare {
2370             SELECT idnum FROM people WHERE name = 'fred'
2371         }]
2372     }
2373     -body {
2374         catch {
2375             ::db transaction {
2376                 set rs [$stmt1 execute]
2377                 rename $rs {}
2378                 error "abort the transaction"
2379             }
2380         } result
2381         set id {failed transaction got committed}
2382         set rs [$stmt2 execute]
2383         while {[$rs nextrow -as lists row]} {
2384             set id [lindex $row 0]
2385         }
2386         rename $rs {}
2387         list $result $id
2388     }
2389     -cleanup {
2390         rename $stmt1 {}
2391         rename $stmt2 {}
2392     }
2393     -result {{abort the transaction} 1}
2394 }
2395
2396 test tdbc::mysql-15.3 {successful transaction gets committed} {*}{
2397     -setup {
2398         set stmt1 [db prepare {
2399             INSERT INTO people(idnum, name, info)
2400             VALUES(7, 'mr. gravel', 0)
2401         }]
2402         set stmt2 [db prepare {
2403             SELECT idnum FROM people WHERE name = 'mr. gravel'
2404         }]
2405     }
2406     -body {
2407         ::db transaction {
2408             set rs [$stmt1 execute]
2409             rename $rs {}
2410         }
2411         set rs [$stmt2 execute]
2412         while {[$rs nextrow -as lists row]} {
2413             set id [lindex $row 0]
2414         }
2415         rename $rs {}
2416         set id
2417     }
2418     -cleanup {
2419         rename $stmt1 {}
2420         rename $stmt2 {}
2421     }
2422     -result 7
2423 }
2424
2425 test tdbc::mysql-15.4 {break out of transaction commits it} {*}{
2426     -setup {
2427         set stmt1 [db prepare {
2428             INSERT INTO people(idnum, name, info)
2429             VALUES(8, 'gary granite', 0)
2430         }]
2431         set stmt2 [db prepare {
2432             SELECT idnum FROM people WHERE name = 'gary granite'
2433         }]
2434     }
2435     -body {
2436         while {1} {
2437             ::db transaction {
2438                 set rs [$stmt1 execute]
2439                 rename $rs {}
2440                 break
2441             }
2442         }
2443         set rs [$stmt2 execute]
2444         while {[$rs nextrow -as lists row]} {
2445             set id [lindex $row 0]
2446         }
2447         rename $rs {}
2448         set id
2449     }
2450     -cleanup {
2451         rename $stmt1 {}
2452         rename $stmt2 {}
2453     }
2454     -result 8
2455 }
2456
2457 test tdbc::mysql-15.5 {continue in transaction commits it} {*}{
2458     -setup {
2459         set stmt1 [db prepare {
2460             INSERT INTO people(idnum, name, info)
2461             VALUES(9, 'hud rockstone', 0)
2462         }]
2463         set stmt2 [db prepare {
2464             SELECT idnum FROM people WHERE name = 'hud rockstone'
2465         }]
2466     }
2467     -body {
2468         for {set i 0} {$i < 1} {incr i} {
2469             ::db transaction {
2470                 set rs [$stmt1 execute]
2471                 rename $rs {}
2472                 continue
2473             }
2474         }
2475         set rs [$stmt2 execute]
2476         while {[$rs nextrow -as lists row]} {
2477             set id [lindex $row 0]
2478         }
2479         rename $rs {}
2480         set id
2481     }
2482     -cleanup {
2483         rename $stmt1 {}
2484         rename $stmt2 {}
2485     }
2486     -result 9
2487 }
2488
2489 test tdbc::mysql-15.6 {return in transaction commits it} {*}{
2490     -setup {
2491         set stmt1 [db prepare {
2492             INSERT INTO people(idnum, name, info)
2493             VALUES(10, 'nelson stoneyfeller', 0)
2494         }]
2495         set stmt2 [db prepare {
2496             SELECT idnum FROM people WHERE name = 'nelson stoneyfeller'
2497         }]
2498         proc tdbcmysql-15.6 {stmt1} {
2499             ::db transaction {
2500                 set rs [$stmt1 execute]
2501                 rename $rs {}
2502                 return
2503             }
2504         }
2505     }
2506     -body {
2507         tdbcmysql-15.6 $stmt1
2508         set rs [$stmt2 execute]
2509         while {[$rs nextrow -as lists row]} {
2510             set id [lindex $row 0]
2511         }
2512         rename $rs {}
2513         set id
2514     }
2515     -cleanup {
2516         rename $stmt1 {}
2517         rename $stmt2 {}
2518         rename tdbcmysql-15.6 {}
2519     }
2520     -result 10
2521 }
2522
2523 test tdbc::mysql-16.1 {database tables, wrong # args} {
2524     -body {
2525         set dict [::db tables % rubbish]
2526     }
2527     -returnCodes error
2528     -match glob
2529     -result {wrong # args*}
2530 }
2531
2532 test tdbc::mysql-16.2 {database tables - empty set} {
2533     -body {
2534         ::db tables q%
2535     }
2536     -result {}
2537 }
2538
2539 test tdbc::mysql-16.3 {enumerate database tables} {*}{
2540     -body {
2541         set dict [::db tables]
2542         list [dict exists $dict people] [dict exists $dict property]
2543     }
2544     -result {1 0}
2545 }
2546
2547 test tdbc::mysql-16.4 {enumerate database tables} {*}{
2548     -body {
2549         set dict [::db tables p%]
2550         list [dict exists $dict people] [dict exists $dict property]
2551     }
2552     -result {1 0}
2553 }
2554
2555 test tdbc::mysql-17.1 {database columns - wrong # args} {*}{
2556     -body {
2557         set dict [::db columns people % rubbish]
2558     }
2559     -returnCodes error
2560     -match glob
2561     -result {wrong # args*}
2562 }
2563
2564 test tdbc::mysql-17.2 {database columns - no such table} {*}{
2565     -body {
2566         ::db columns rubbish
2567     }
2568     -returnCodes error
2569     -match glob
2570     -result {Table * doesn't exist}
2571 }
2572
2573 test tdbc::mysql-17.3 {database columns - no match pattern} {*}{
2574     -body {
2575         set result {}
2576         dict for {colname attrs} [::db columns people] {
2577             lappend result $colname \
2578                 [dict get $attrs type] \
2579                 [expr {[dict exists $attrs precision] ?
2580                        [dict get $attrs precision] : {NULL}}] \
2581                 [expr {[dict exists $attrs scale] ?
2582                        [dict get $attrs scale] : {NULL}}] \
2583                 [dict get $attrs nullable]
2584         }
2585         set result
2586     }
2587     -match glob
2588     -result {idnum integer * 0 0 name varchar 40 * info integer * 0 1}
2589 }
2590
2591 # sqlite driver appears not to implement pattern matching for SQLGetColumns
2592 test tdbc::mysql-17.4 {database columns - match pattern} {*}{
2593     -constraints !sqlite
2594     -body {
2595         set result {}
2596         dict for {colname attrs} [::db columns people i%] {
2597             lappend result $colname \
2598                 [dict get $attrs type] \
2599                 [expr {[dict exists $attrs precision] ?
2600                        [dict get $attrs precision] : {NULL}}] \
2601                 [expr {[dict exists $attrs scale] ?
2602                        [dict get $attrs scale] : {NULL}}] \
2603                 [dict get $attrs nullable]
2604         }
2605         set result
2606     }
2607     -result {idnum integer 11 0 0 info integer 11 0 1}
2608 }
2609
2610 test tdbc::mysql-18.1 {$statement params - excess arg} {*}{
2611     -setup {
2612         set s [::db prepare {
2613             SELECT name FROM people
2614             WHERE name LIKE :pattern
2615             AND idnum >= :minid
2616         }]
2617         $s paramtype minid numeric 10 0
2618         $s paramtype pattern varchar 40
2619     }
2620     -body {
2621         $s params excess
2622     }
2623     -cleanup {
2624         rename $s {}
2625     }
2626     -returnCodes error
2627     -match glob
2628     -result {wrong # args*}
2629 }
2630
2631 test tdbc::mysql-18.2 {$statement params - no params} {*}{
2632     -setup {
2633         set s [::db prepare {
2634             SELECT name FROM people
2635         }]
2636     }
2637     -body {
2638         $s params
2639     }
2640     -cleanup {
2641         rename $s {}
2642     }
2643     -result {}
2644 }
2645
2646 test tdbc::mysql-18.3 {$statement params - try a few data types} {*}{
2647     -setup {
2648         set s [::db prepare {
2649             SELECT name FROM people
2650             WHERE name LIKE :pattern
2651             AND idnum >= :minid
2652         }]
2653         $s paramtype minid decimal 10 0
2654         $s paramtype pattern varchar 40
2655     }
2656     -body {
2657         set d [$s params]
2658         list \
2659             [dict get $d minid direction] \
2660             [dict get $d minid type] \
2661             [dict get $d minid precision] \
2662             [dict get $d minid scale] \
2663             [dict get $d pattern direction] \
2664             [dict get $d pattern type] \
2665             [dict get $d pattern precision]
2666     }
2667     -cleanup {
2668         rename $s {}
2669     }
2670     -result {in decimal 10 0 in varchar 40}
2671 }
2672
2673 test tdbc::mysql-19.1 {$connection configure - no args} \
2674     -body {
2675         ::db configure
2676     } \
2677     -match glob \
2678     -result [list \
2679                  -compress * -database * -encoding utf-8 \
2680                  -host * -interactive * -isolation repeatableread \
2681                  -password {} -port * -readonly 0 -socket * \
2682                  -ssl_ca * -ssl_capath * -ssl_cert * -ssl_cipher * \
2683                  -ssl_key * -timeout * -user *]
2684
2685 test tdbc::mysql-19.2 {$connection configure - unknown arg} {*}{
2686     -body {
2687         ::db configure -junk
2688     }
2689     -returnCodes error
2690     -match glob
2691     -result "bad option *"
2692 }
2693
2694 test tdbc::mysql-19.3 {$connection configure - unknown arg} {*}{
2695     -body {
2696         list [catch {::db configure -rubbish} result] $result $::errorCode
2697     }
2698     -match glob
2699     -result {1 {bad option "-rubbish": must be *} {TCL LOOKUP INDEX option -rubbish}}
2700 }
2701
2702 test tdbc::mysql-19.4 {$connection configure - set unknown arg} {*}{
2703     -body {
2704         list [catch {::db configure -rubbish rubbish} result] \
2705             $result $::errorCode
2706     }
2707     -match glob
2708     -result {1 {bad option "-rubbish": must be *} {TCL LOOKUP INDEX option -rubbish}}
2709 }
2710
2711 test tdbc::mysql-19.5 {$connection configure - set inappropriate arg} {*}{
2712     -body {
2713         list [catch {::db configure -encoding ebcdic} result] \
2714             $result $::errorCode
2715     }
2716     -result {1 {"-encoding" option cannot be changed dynamically} {TDBC GENERAL_ERROR HY000 MYSQL -1}}
2717 }
2718
2719 test tdbc::mysql-19.6 {$connection configure - wrong # args} {*}{
2720     -body {
2721         ::db configure -parent . -junk
2722     }
2723     -returnCodes error
2724     -match glob
2725     -result "wrong # args*"
2726 }
2727
2728 test tdbc::mysql-19.9 {$connection configure - -encoding} {*}{
2729     -body {
2730         ::db configure -encoding
2731     }
2732     -result utf-8
2733 }
2734
2735
2736 test tdbc::mysql-19.10 {$connection configure - -isolation} {*}{
2737     -body {
2738         ::db configure -isolation junk
2739     }
2740     -returnCodes error
2741     -match glob
2742     -result {bad isolation level "junk"*}
2743 }
2744
2745 test tdbc::mysql-19.11 {$connection configure - -isolation} {*}{
2746     -body {
2747         list [::db configure -isolation readuncommitted] \
2748             [::db configure -isolation] \
2749             [::db configure -isolation readcommitted] \
2750             [::db configure -isolation] \
2751             [::db configure -isolation serializable] \
2752             [::db configure -isolation] \
2753             [::db configure -isolation repeatableread] \
2754             [::db configure -isolation]
2755     }
2756     -result {{} readuncommitted {} readcommitted {} serializable {} repeatableread}
2757 }
2758
2759 test tdbc::mysql-19.12 {$connection configure - -readonly} {*}{
2760     -body {
2761         ::db configure -readonly junk
2762     }
2763     -returnCodes error
2764     -result {"-readonly" option cannot be changed dynamically}
2765 }
2766
2767 test tdbc::mysql-19.13 {$connection configure - -readonly} {*}{
2768     -body {
2769         ::db configure -readonly
2770     }
2771     -result 0
2772 }
2773
2774 test tdbc::mysql-19.14 {$connection configure - -timeout} {*}{
2775     -body {
2776         ::db configure -timeout junk
2777     }
2778     -returnCodes error
2779     -result {expected integer but got "junk"}
2780 }
2781
2782 test tdbc::mysql-19.15 {$connection configure - -timeout} {*}{
2783     -body {
2784         set x [::db configure -timeout]
2785         list [::db configure -timeout 5000] [::db configure -timeout] \
2786             [::db configure -timeout $x]
2787     }
2788     -result {{} 5000 {}}
2789 }
2790
2791 test tdbc::mysql-19.16 {$connection configure - -db} {*}{
2792     -body {
2793         set x [::db configure -db]
2794         list [::db configure -db information_schema] \
2795             [::db configure -db] \
2796             [::db configure -db $x]
2797     }
2798     -result {{} information_schema {}}
2799 }
2800
2801 test tdbc::mysql-19.17 {$connection configure - -user} \
2802     -body {
2803         set flags $::connFlags
2804         dict unset flags -host
2805         catch [dict unset flags -port]
2806         catch [dict unset flags -socket]
2807         set flags2 $flags
2808         dict set flags -db information_schema
2809         list [::db configure {*}$flags] [::db configure -db] \
2810             [::db configure {*}$flags2] [::db configure -db]
2811     } \
2812     -result [list {} information_schema {} [dict get $connFlags -db]]
2813
2814 test tdbc::mysql-20.1 {bit values} {*}{
2815     -setup {
2816         catch {db allrows {DROP TABLE bittest}}
2817         db allrows {
2818             CREATE TABLE bittest (
2819                 bitstring BIT(14)
2820             )
2821         }
2822         db allrows {INSERT INTO bittest(bitstring) VALUES(b'11010001010110')}
2823     }
2824     -body {
2825         db allrows {SELECT bitstring FROM bittest}
2826     }
2827     -result {{bitstring 13398}}
2828     -cleanup {
2829         db allrows {DROP TABLE bittest}
2830     }
2831 }
2832
2833 test tdbc::mysql-20.2 {direct value transfers} {*}{
2834     -setup {
2835         set bigtext [string repeat a 200]
2836         set bigbinary [string repeat \xc2\xa1 100]
2837         catch {db allrows {DROP TABLE typetest}}
2838         db allrows {
2839             CREATE TABLE typetest (
2840                 xtiny1 TINYINT,
2841                 xsmall1 SMALLINT,
2842                 xint1 INTEGER,
2843                 xfloat1 FLOAT,
2844                 xdouble1 DOUBLE,
2845                 xtimestamp1 TIMESTAMP,
2846                 xbig1 BIGINT,
2847                 xmed1 MEDIUMINT,
2848                 xdate1 DATE,
2849                 xtime1 TIME,
2850                 xdatetime1 DATETIME,
2851                 xyear1 YEAR,
2852                 xbit1 BIT(14),
2853                 xdec1 DECIMAL(10),
2854                 xtinyt1 TINYTEXT,
2855                 xtinyb1 TINYBLOB,
2856                 xmedt1 MEDIUMTEXT,
2857                 xmedb1 MEDIUMBLOB,
2858                 xlongt1 LONGTEXT,
2859                 xlongb1 LONGBLOB,
2860                 xtext1 TEXT,
2861                 xblob1 BLOB,
2862                 xvarb1 VARBINARY(256),
2863                 xvarc1 VARCHAR(256),
2864                 xbin1 BINARY(20),
2865                 xchar1 CHAR(20)
2866             )
2867         }
2868         set stmt [db prepare {
2869             INSERT INTO typetest(
2870                 xtiny1,         xsmall1,        xint1,          xfloat1,
2871                 xdouble1,       xtimestamp1,    xbig1,          xmed1,
2872                 xdate1,         xtime1,         xdatetime1,     xyear1,
2873                 xbit1,          xdec1,          xtinyt1,        xtinyb1,
2874                 xmedt1,         xmedb1,         xlongt1,        xlongb1,
2875                 xtext1,         xblob1,         xvarb1,         xvarc1,
2876                 xbin1,          xchar1
2877             ) values (
2878                 :xtiny1,        :xsmall1,       :xint1,         :xfloat1,
2879                 :xdouble1,      :xtimestamp1,   :xbig1,         :xmed1,
2880                 :xdate1,        :xtime1,        :xdatetime1,    :xyear1,
2881                 :xbit1,         :xdec1,         :xtinyt1,       :xtinyb1,
2882                 :xmedt1,        :xmedb1,        :xlongt1,       :xlongb1,
2883                 :xtext1,        :xblob1,        :xvarb1,        :xvarc1,
2884                 :xbin1,         :xchar1
2885             )
2886         }]
2887         $stmt paramtype xtiny1 tinyint
2888         $stmt paramtype xsmall1 smallint
2889         $stmt paramtype xint1 integer
2890         $stmt paramtype xfloat1 float
2891         $stmt paramtype xdouble1 double
2892         $stmt paramtype xtimestamp1 timestamp
2893         $stmt paramtype xbig1 bigint
2894         $stmt paramtype xmed1 mediumint
2895         $stmt paramtype xdate1 date
2896         $stmt paramtype xtime1 time
2897         $stmt paramtype xdatetime1 datetime
2898         $stmt paramtype xyear1 year
2899         $stmt paramtype xbit1 bit 14
2900         $stmt paramtype xdec1 decimal 10 0
2901         $stmt paramtype xtinyt1 tinytext
2902         $stmt paramtype xtinyb1 tinyblob
2903         $stmt paramtype xmedt1 mediumtext
2904         $stmt paramtype xmedb1 mediumblob
2905         $stmt paramtype xlongt1 longtext
2906         $stmt paramtype xlongb1 longblob
2907         $stmt paramtype xtext1 text
2908         $stmt paramtype xblob1 blob
2909         $stmt paramtype xvarb1 varbinary
2910         $stmt paramtype xvarc1 varchar
2911         $stmt paramtype xbin1 binary 20
2912         $stmt paramtype xchar1 char 20
2913     }
2914     -body {
2915         set trouble {}
2916         set xtiny1 0x14
2917         set xsmall1 0x3039
2918         set xint1 0xbc614e
2919         set xfloat1 1.125
2920         set xdouble1 1.125
2921         set xtimestamp1 {2001-02-03 04:05:06}
2922         set xbig1 0xbc614e
2923         set xmed1 0x3039
2924         set xdate1 2001-02-03
2925         set xtime1 04:05:06
2926         set xdatetime1 {2001-02-03 04:05:06}
2927         set xyear1 2001
2928         set xbit1 0b11010001010110
2929         set xdec1 0xbc614e
2930         set xtinyt1 $bigtext
2931         set xtinyb1 $bigbinary
2932         set xmedt1 $bigtext
2933         set xmedb1 $bigbinary
2934         set xlongt1 $bigtext
2935         set xlongb1 $bigbinary
2936         set xtext1 $bigtext
2937         set xblob1 $bigbinary
2938         set xvarb1 $bigbinary
2939         set xvarc1 $bigtext
2940         set xbin1 [string repeat \xc2\xa1 10]
2941         set xchar1 [string repeat a 20]
2942         $stmt allrows
2943         db foreach row {select * from typetest} {
2944             foreach v {
2945                 xtiny1          xsmall1         xint1           xfloat1
2946                 xdouble1        xtimestamp1     xbig1           xmed1
2947                 xdate1          xtime1          xdatetime1      xyear1
2948                 xbit1           xdec1           xtinyt1         xtinyb1
2949                 xmedt1          xmedb1          xlongt1         xlongb1
2950                 xtext1          xblob1          xvarb1          xvarc1
2951                 xbin1           xchar1
2952             } {
2953                 if {![dict exists $row $v]} {
2954                     append trouble $v " did not appear in result set\n"
2955                 } elseif {[set $v] != [dict get $row $v]} {
2956                     append trouble [list $v is [dict get $row $v] \
2957                                         should be [set $v]] \n
2958                 }
2959             }
2960         }
2961         set trouble
2962     }
2963     -result {}
2964     -cleanup {
2965         $stmt close
2966         db allrows {
2967             DROP TABLE typetest
2968         }
2969     }
2970 }
2971
2972 test tdbc::mysql-21.2 {transfers of binary data} {*}{
2973     -setup {
2974         catch {
2975             db allrows {DROP TABLE bintest}
2976         }
2977         db allrows {
2978             CREATE TABLE bintest (
2979                 xint1 INTEGER PRIMARY KEY,
2980                 xbin VARBINARY(256)
2981             )
2982         }
2983         set stmt1 [db prepare {
2984             INSERT INTO bintest (xint1, xbin)
2985             VALUES(:i1, :b1)
2986         }]
2987         $stmt1 paramtype i1 integer
2988         $stmt1 paramtype b1 varbinary 256
2989         set stmt2 [db prepare {
2990             SELECT xbin FROM bintest WHERE xint1 = :i1
2991         }]
2992         $stmt2 paramtype i1 integer
2993     }
2994     -body {
2995         set listdata {}
2996         for {set i 0} {$i < 256} {incr i} {
2997             lappend listdata $i
2998         }
2999         set b1 [binary format c* $listdata]
3000         set i1 123
3001         $stmt1 allrows
3002         $stmt2 foreach -as lists row { set b2 [lindex $row 0] }
3003         list [string length $b2] [string compare $b1 $b2]
3004     }
3005     -result {256 0}
3006     -cleanup {
3007         $stmt1 close
3008         $stmt2 close
3009         db allrows {DROP TABLE bintest}
3010     }
3011 }
3012
3013 test tdbc::mysql-22.1 {duplicate column name} {*}{
3014     -body {
3015         set stmt [::db prepare {
3016             SELECT a.idnum, b.idnum
3017             FROM people a, people b
3018             WHERE a.name = 'hud rockstone'
3019             AND b.info = a.info
3020         }]
3021         set rs [$stmt execute]
3022         $rs columns
3023     }
3024     -result {idnum idnum#2}
3025     -cleanup {
3026         $rs close
3027         $stmt close
3028     }
3029 }
3030
3031 # Information schema tests require additional tables in the database.
3032 # Create them now.
3033
3034 catch {::db allrows {DROP TABLE d}}
3035 catch {::db allrows {DROP TABLE c}}
3036 catch {::db allrows {DROP TABLE b}}
3037 catch {::db allrows {DROP TABLE a}}
3038
3039 # The MyISAM engine doesn't track foreign key constraints, so force the
3040 # tables to be InnoDB.
3041
3042 ::db allrows {
3043     CREATE TABLE a (
3044         k1 INTEGER,
3045         CONSTRAINT pk_a PRIMARY KEY(k1)
3046     ) ENGINE=InnoDB
3047 }
3048
3049 ::db allrows {
3050     CREATE TABLE b (
3051         k1 INTEGER,
3052         k2 INTEGER,
3053         CONSTRAINT pk_b PRIMARY KEY(k1, k2),
3054         CONSTRAINT fk_b1 FOREIGN KEY (k1) REFERENCES a(k1),
3055         CONSTRAINT fk_b2 FOREIGN KEY (k2) REFERENCES a(k1)
3056     ) ENGINE=InnoDB
3057 }
3058
3059 ::db allrows {
3060     CREATE TABLE c (
3061         p1 INTEGER,
3062         p2 INTEGER,
3063         CONSTRAINT pk_c PRIMARY KEY(p1, p2),
3064         CONSTRAINT fk_c1 FOREIGN KEY (p1) REFERENCES a(k1),
3065         CONSTRAINT fk_c2 FOREIGN KEY (p2) REFERENCES a(k1),
3066         CONSTRAINT fk_cpair FOREIGN KEY (p1,p2) REFERENCES b(k2,k1)
3067     ) ENGINE=InnoDB
3068 }
3069
3070 ::db allrows {
3071     CREATE TABLE d (
3072         dtext VARCHAR(40)
3073     ) ENGINE=InnoDB
3074 }
3075
3076 test tdbc::mysql-23.1 {Primary keys - no arg} {*}{
3077     -body {
3078         ::db primarykeys
3079     }
3080     -returnCodes error
3081     -match glob
3082     -result {wrong # args*}
3083 }
3084 test tdbc::mysql-23.2 {Primary keys - no primary key} {*}{
3085     -body {
3086         ::db primarykeys d
3087     }
3088     -result {}
3089 }
3090 test tdbc::mysql-23.3 {Primary keys - simple primary key} {*}{
3091     -body {
3092         set result {}
3093         foreach row [::db primarykeys a] {
3094             lappend result [dict get $row columnName] [dict get $row ordinalPosition]
3095         }
3096         set result
3097     }
3098     -result {k1 1}
3099 }
3100 test tdbc::mysql-23.4 {Primary keys - compound primary key} {*}{
3101     -body {
3102         set result {}
3103         foreach row [::db primarykeys b] {
3104             lappend result [dict get $row columnName] [dict get $row ordinalPosition]
3105         }
3106         set result
3107     }
3108     -result {k1 1 k2 2}
3109 }
3110
3111 test tdbc::mysql-24.1 {Foreign keys - wrong # args} {*}{
3112     -body {
3113         ::db foreignkeys -wrong
3114     }
3115     -returnCodes error
3116     -match glob
3117     -result {wrong # args*}
3118 }
3119
3120 test tdbc::mysql-24.2 {Foreign keys - bad arg} {*}{
3121     -body {
3122         ::db foreignkeys -primary a -rubbish b
3123     }
3124     -returnCodes error
3125     -match glob
3126     -result {bad option "-rubbish"*}
3127 }
3128
3129 test tdbc::mysql-24.3 {Foreign keys - redundant arg} {*}{
3130     -body {
3131         ::db foreignkeys -primary a -primary b
3132     }
3133     -returnCodes error
3134     -match glob
3135     -result {duplicate option "primary"*}
3136 }
3137
3138 test tdbc::mysql-24.4 {Foreign keys - list all} \
3139     -constraints mysqlAtLeast5116 \
3140     -body {
3141         set result {}
3142         set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3143         foreach row [::db foreignkeys] {
3144             if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3145                 dict set result [dict get $row foreignConstraintName] \
3146                     [dict get $row ordinalPosition] \
3147                     [list [dict get $row foreignTable] \
3148                          [dict get $row foreignColumn] \
3149                          [dict get $row primaryTable] \
3150                          [dict get $row primaryColumn]]
3151             }
3152         }
3153         lsort -index 0 -stride 2 $result
3154     } \
3155     -result [list \
3156                  fk_b1 {1 {b k1 a k1}} \
3157                  fk_b2 {1 {b k2 a k1}} \
3158                  fk_c1 {1 {c p1 a k1}} \
3159                  fk_c2 {1 {c p2 a k1}} \
3160                  fk_cpair {1 {c p1 b k2} 2 {c p2 b k1}}]
3161
3162 test tdbc::mysql-24.5 {Foreign keys - -foreign} \
3163     -constraints mysqlAtLeast5116 \
3164     -body {
3165         set result {}
3166         set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3167         foreach row [::db foreignkeys -foreign c] {
3168             if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3169                 dict set result [dict get $row foreignConstraintName] \
3170                     [dict get $row ordinalPosition] \
3171                     [list [dict get $row foreignTable] \
3172                          [dict get $row foreignColumn] \
3173                          [dict get $row primaryTable] \
3174                          [dict get $row primaryColumn]]
3175             }
3176         }
3177         lsort -index 0 -stride 2 $result
3178     } \
3179     -result [list \
3180                  fk_c1 {1 {c p1 a k1}} \
3181                  fk_c2 {1 {c p2 a k1}} \
3182                  fk_cpair {1 {c p1 b k2} 2 {c p2 b k1}}]
3183
3184 test tdbc::mysql-24.6 {Foreign keys - -primary} \
3185     -constraints mysqlAtLeast5116 \
3186     -body {
3187         set result {}
3188         set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3189         foreach row [::db foreignkeys -primary a] {
3190             if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3191                 dict set result [dict get $row foreignConstraintName] \
3192                     [dict get $row ordinalPosition] \
3193                     [list [dict get $row foreignTable] \
3194                          [dict get $row foreignColumn] \
3195                          [dict get $row primaryTable] \
3196                          [dict get $row primaryColumn]]
3197             }
3198         }
3199         lsort -index 0 -stride 2 $result
3200     } \
3201     -result [list \
3202                  fk_b1 {1 {b k1 a k1}} \
3203                  fk_b2 {1 {b k2 a k1}} \
3204                  fk_c1 {1 {c p1 a k1}} \
3205                  fk_c2 {1 {c p2 a k1}}]
3206
3207 test tdbc::mysql-24.7 {Foreign keys - -foreign and -primary} \
3208     -constraints mysqlAtLeast5116 \
3209     -body {
3210         set result {}
3211         set wanted {fk_b1 {} fk_b2 {} fk_c1 {} fk_c2 {} fk_cpair {}}
3212         foreach row [::db foreignkeys -foreign c -primary b] {
3213             if {[dict exists $wanted [dict get $row foreignConstraintName]]} {
3214                 dict set result [dict get $row foreignConstraintName] \
3215                     [dict get $row ordinalPosition] \
3216                     [list [dict get $row foreignTable] \
3217                          [dict get $row foreignColumn] \
3218                          [dict get $row primaryTable] \
3219                          [dict get $row primaryColumn]]
3220             }
3221         }
3222         lsort -index 0 -stride 2 $result
3223     } \
3224     -result [list fk_cpair {1 {c p1 b k2} 2 {c p2 b k1}}]
3225
3226 # MySQL doesn't "do nothing gracefully", so the empty statement yields an
3227 # error rather than an empty result set.
3228 test tdbc::mysql-30.0 {Multiple result sets} {*}{
3229     -constraints knownBug
3230     -setup {
3231         set stmt [::db prepare { }]
3232     }
3233     -body {
3234         set resultset [$stmt execute {}]
3235     }
3236     -cleanup {
3237         $stmt close
3238     }
3239     -returnCodes error
3240     -result {empty query}
3241 }
3242
3243 test tdbc::mysql-30.1 {Multiple result sets - but in reality only one} {*}{
3244     -setup {
3245         ::db allrows {delete from people}
3246         set stmt [db prepare {
3247             INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL)
3248         }]
3249         $stmt paramtype idnum integer
3250         $stmt paramtype name varchar 40
3251         set idnum 1
3252         foreach name {fred wilma pebbles barney betty bam-bam} {
3253             set rs [$stmt execute]
3254             rename $rs {}
3255             incr idnum
3256         }
3257         rename $stmt {}
3258     }
3259     -body {
3260         set stmt [::db prepare {
3261             select idnum, name from people where name = :a
3262         }]
3263         catch {
3264             set resultset [$stmt execute {a wilma}]
3265             catch {
3266                 set rowsets {}
3267                 while {1} {
3268                     set rows {}
3269                     while {[$resultset nextrow row]} {
3270                         lappend rows $row
3271                     }
3272                     lappend rowsets $rows
3273                     if {[$resultset nextresults] == 0} break
3274                 }
3275                 set rowsets
3276             } results
3277             rename $resultset {}
3278             set results
3279         } results
3280         rename $stmt {}
3281         set results
3282     }
3283     -result {{{idnum 2 name wilma}}}
3284 }
3285
3286
3287 #-------------------------------------------------------------------------------
3288
3289 # Test cleanup. Drop tables and get rid of the test database.
3290
3291
3292 catch {::db allrows {DROP TABLE d}}
3293 catch {::db allrows {DROP TABLE c}}
3294 catch {::db allrows {DROP TABLE b}}
3295 catch {::db allrows {DROP TABLE a}}
3296 catch {::db allrows {DROP TABLE people}}
3297
3298 catch {rename ::db {}}
3299
3300 cleanupTests
3301 return
3302
3303 # Local Variables:
3304 # mode: tcl
3305 # End: