├── pkgIndex.tcl.in ├── README ├── tests ├── all.tcl └── tdbcsqlite3.test ├── license.terms ├── aclocal.m4 ├── doc └── tdbc_sqlite3.n ├── configure.in ├── ChangeLog ├── Makefile.in ├── win ├── makefile.vc ├── nmakehlp.c └── rules.vc └── library └── tdbcsqlite3.tcl /pkgIndex.tcl.in: -------------------------------------------------------------------------------- 1 | # 2 | # Tcl package index file 3 | # 4 | package ifneeded tdbc::sqlite3 @PACKAGE_VERSION@ \ 5 | [list source [file join $dir .. library tdbcsqlite3.tcl]] 6 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | README: tdbcsqlite3 2 | 3 | This is the 1.0.0 source distribution of the bridge between Tcl 4 | Database Connectivity (TDBC) and SQLite3, an open-source SQL 5 | database with an in-process server. 6 | 7 | TDBC and its drivers are available from a Fossil version control 8 | repository at http://tdbc.tcl.tk/ 9 | 10 | SQLite3 is available from http://sqlite.org/ 11 | 12 | RCS: @(#) $Id: $ 13 | 14 | 1. Introduction 15 | 16 | This directory contains the source code, documentation, and test 17 | scripts for the SQLite3 driver for Tcl Database Connectivity. This 18 | module, plus TDBC and SQLite3 themselves, allow you to access SQLite3 19 | databases using a standard application programming interface (API) 20 | from a Tcl script. This module is also available from 21 | http://tdbc.tcl.tk along with the source code of TDBC itself. A bug 22 | database and Wiki are available at the same location. 23 | 24 | Tdbc::sqlite3 is a freely-available open source package. You can do 25 | virtually anything you like with it, such as modifying it, 26 | redistributing it, and selling it either in whole or in part. See the 27 | file "license.terms" for complete information. 28 | 29 | 2. Documentation 30 | 31 | The 'doc' subdirectory in this release contains a set of reference 32 | manual entries for tdbc::sqlite3. Files with an extension '.n' are for 33 | Tcl classes and commands; files with an extension '.3' are for C 34 | library functions. The file, 'doc/tdbcsqlite3.n' gives an overview, 35 | listing the classes and functions 36 | 37 | 3. See also 38 | 39 | More information about TDBC and its drivers are available in the 40 | README file for TDBC itself; refer to that file for compilation and 41 | installation instructions, and support information. 42 | -------------------------------------------------------------------------------- /tests/all.tcl: -------------------------------------------------------------------------------- 1 | # all.tcl -- 2 | # 3 | # This file contains a top-level script to run all of the Tcl 4 | # tests. Execute it by invoking "source all.test" when running tcltest 5 | # in this directory. 6 | # 7 | # Copyright (c) 1998-2000 by Scriptics Corporation. 8 | # All rights reserved. 9 | # 10 | # RCS: @(#) $Id: all.tcl,v 1.4 2004/07/04 22:04:20 patthoyts Exp $ 11 | 12 | if {[lsearch [namespace children] ::tcltest] == -1} { 13 | package require tcltest 14 | namespace import ::tcltest::* 15 | } 16 | 17 | set ::tcltest::testSingleFile false 18 | set ::tcltest::testsDirectory [file dir [info script]] 19 | 20 | # We need to ensure that the testsDirectory is absolute 21 | if {[catch {::tcltest::normalizePath ::tcltest::testsDirectory}]} { 22 | # The version of tcltest we have here does not support 23 | # 'normalizePath', so we have to do this on our own. 24 | 25 | set oldpwd [pwd] 26 | catch {cd $::tcltest::testsDirectory} 27 | set ::tcltest::testsDirectory [pwd] 28 | cd $oldpwd 29 | } 30 | 31 | set chan $::tcltest::outputChannel 32 | 33 | puts $chan "Tests running in interp: [info nameofexecutable]" 34 | puts $chan "Tests running with pwd: [pwd]" 35 | puts $chan "Tests running in working dir: $::tcltest::testsDirectory" 36 | if {[llength $::tcltest::skip] > 0} { 37 | puts $chan "Skipping tests that match: $::tcltest::skip" 38 | } 39 | if {[llength $::tcltest::match] > 0} { 40 | puts $chan "Only running tests that match: $::tcltest::match" 41 | } 42 | 43 | if {[llength $::tcltest::skipFiles] > 0} { 44 | puts $chan "Skipping test files that match: $::tcltest::skipFiles" 45 | } 46 | if {[llength $::tcltest::matchFiles] > 0} { 47 | puts $chan "Only sourcing test files that match: $::tcltest::matchFiles" 48 | } 49 | 50 | set timeCmd {clock format [clock seconds]} 51 | puts $chan "Tests began at [eval $timeCmd]" 52 | 53 | # source each of the specified tests 54 | foreach file [lsort [::tcltest::getMatchingFiles]] { 55 | set tail [file tail $file] 56 | puts $chan $tail 57 | if {[catch {source $file} msg]} { 58 | puts $chan $msg 59 | } 60 | } 61 | 62 | # cleanup 63 | puts $chan "\nTests ended at [eval $timeCmd]" 64 | ::tcltest::cleanupTests 1 65 | return 66 | 67 | -------------------------------------------------------------------------------- /license.terms: -------------------------------------------------------------------------------- 1 | This software is copyrighted by the Scriptics Corporation, and other 2 | parties. The following terms apply to all files associated with the 3 | software unless explicitly disclaimed in individual files. 4 | 5 | The authors hereby grant permission to use, copy, modify, distribute, 6 | and license this software and its documentation for any purpose, provided 7 | that existing copyright notices are retained in all copies and that this 8 | notice is included verbatim in any distributions. No written agreement, 9 | license, or royalty fee is required for any of the authorized uses. 10 | Modifications to this software may be copyrighted by their authors 11 | and need not follow the licensing terms described here, provided that 12 | the new terms are clearly indicated on the first page of each file where 13 | they apply. 14 | 15 | IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 16 | FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 17 | ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 18 | DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 19 | POSSIBILITY OF SUCH DAMAGE. 20 | 21 | THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 22 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 23 | FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 24 | IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 25 | NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 26 | MODIFICATIONS. 27 | 28 | GOVERNMENT USE: If you are acquiring this software on behalf of the 29 | U.S. government, the Government shall have only "Restricted Rights" 30 | in the software and related documentation as defined in the Federal 31 | Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you 32 | are acquiring the software on behalf of the Department of Defense, the 33 | software shall be classified as "Commercial Computer Software" and the 34 | Government shall have only "Restricted Rights" as defined in Clause 35 | 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the 36 | authors grant the U.S. Government and others acting in its behalf 37 | permission to use and distribute the software in accordance with the 38 | terms specified in this license. 39 | -------------------------------------------------------------------------------- /aclocal.m4: -------------------------------------------------------------------------------- 1 | # 2 | # Include the TEA standard macro set 3 | # 4 | 5 | builtin(include,tclconfig/tcl.m4) 6 | 7 | # 8 | # Add here whatever m4 macros you want to define for your package 9 | # 10 | 11 | dnl Helper macros 12 | AC_DEFUN([TEAX_LAPPEND], [$1="[$]{$1} $2"]) 13 | AC_DEFUN([TEAX_FOREACH], [for $1 in $2; do $3; done]) 14 | AC_DEFUN([TEAX_IFEQ], [AS_IF([test "x$1" = "x$2"], [$3])]) 15 | AC_DEFUN([TEAX_IFNEQ], [AS_IF([test "x$1" != "x$2"], [$3])]) 16 | AC_DEFUN([TEAX_SWITCH], [case "$1" in TEAX_SWITCH_Cases(m4_shift($@)) esac]) 17 | AC_DEFUN([TEAX_SWITCH_Cases], [m4_if([$#],0,,[$#],1,,[TEAX_SWITCH_OneCase($1,$2)TEAX_SWITCH_Cases(m4_shift(m4_shift($@)))])]) 18 | AC_DEFUN([TEAX_SWITCH_OneCase],[ $1) $2;;]) 19 | AC_DEFUN([CygPath],[`${CYGPATH} $1`]) 20 | 21 | dnl Interesting macros 22 | AC_DEFUN([TEAX_SUBST_RESOURCE], [ 23 | AC_REQUIRE([TEA_CONFIG_CFLAGS])dnl 24 | TEAX_IFEQ($TEA_PLATFORM, windows, [ 25 | AC_CHECK_PROGS(RC_, 'windres -o' 'rc -nologo -fo', none) 26 | TEAX_SWITCH($RC_, 27 | windres*, [ 28 | rcdef_inc="--include " 29 | rcdef_start="--define " 30 | rcdef_q='\"' 31 | AC_SUBST(RES_SUFFIX, [res.o]) 32 | TEAX_LAPPEND(PKG_OBJECTS, ${PACKAGE_NAME}.res.o)], 33 | rc*, [ 34 | rcdef_inc="-i " 35 | rcdef_start="-d " 36 | rcdef_q='"' 37 | AC_SUBST(RES_SUFFIX, [res]) 38 | TEAX_LAPPEND(PKG_OBJECTS, ${PACKAGE_NAME}.res)], 39 | *, [ 40 | AC_MSG_WARN([could not find resource compiler]) 41 | RC_=: ])]) 42 | # This next line is because of the brokenness of TEA... 43 | AC_SUBST(RC, $RC_) 44 | TEAX_FOREACH(i, $1, [ 45 | TEAX_LAPPEND(RES_DEFS, ${rcdef_inc}\"CygPath($i)\")]) 46 | TEAX_FOREACH(i, $2, [ 47 | TEAX_LAPPEND(RES_DEFS, ${rcdef_start}$i='${rcdef_q}\$($i)${rcdef_q}')]) 48 | AC_SUBST(RES_DEFS)]) 49 | AC_DEFUN([TEAX_ADD_PRIVATE_HEADERS], [ 50 | TEAX_FOREACH(i, $@, [ 51 | # check for existence, be strict because it should be present! 52 | AS_IF([test ! -f "${srcdir}/$i"], [ 53 | AC_MSG_ERROR([could not find header file '${srcdir}/$i'])]) 54 | TEAX_LAPPEND(PKG_PRIVATE_HEADERS, $i)]) 55 | AC_SUBST(PKG_PRIVATE_HEADERS)]) 56 | 57 | dnl Extra magic to make things work with Vista and VC 58 | AC_DEFUN([TEAX_VC_MANIFEST], [ 59 | ADD_MANIFEST=":" 60 | AS_IF([test "$GCC" != yes \ 61 | -a ${TEA_PLATFORM} == "windows" \ 62 | -a "${SHARED_BUILD}" = "1"], [ 63 | # This refers to "Manifest Tool" not "Magnetic Tape utility" 64 | AC_CHECK_PROGS(MT, mt, none) 65 | AS_IF([test "$MT" != none], [ 66 | ADD_MANIFEST="${MT} -nologo -manifest [\$]@.manifest -outputresource:[\$]@\;2" 67 | CLEANFILES="$CLEANFILES ${PKG_LIB_FILE}.manifest"])]) 68 | AC_SUBST(ADD_MANIFEST)]) 69 | 70 | AC_DEFUN([TEAX_SDX], [ 71 | AC_PATH_PROG(SDX, sdx, none) 72 | TEAX_IFEQ($SDX, none, [ 73 | AC_PATH_PROG(SDX_KIT, sdx.kit, none) 74 | TEAX_IFNEQ($SDX_KIT, none, [ 75 | # We assume that sdx.kit is on the path, and that the default 76 | # tclsh is activetcl 77 | SDX="tclsh '${SDX_KIT}'"])]) 78 | TEAX_IFEQ($SDX, none, [ 79 | AC_MSG_WARN([cannot find sdx; building starkits will fail]) 80 | AC_MSG_NOTICE([building as a normal library still supported])])]) 81 | dnl TODO: Adapt this for OSX Frameworks... 82 | dnl This next bit is a bit ugly, but it makes things for tclooConfig.sh... 83 | AC_DEFUN([TEAX_PATH_LINE], [ 84 | eval "$1=\"[]CygPath($2)\"" 85 | AC_SUBST($1)]) 86 | AC_DEFUN([TEAX_INCLUDE_LINE], [ 87 | eval "$1=\"-I[]CygPath($2)\"" 88 | AC_SUBST($1)]) 89 | AC_DEFUN([TEAX_LINK_LINE], [ 90 | AS_IF([test ${TCL_LIB_VERSIONS_OK} = nodots], [ 91 | eval "$1=\"-L[]CygPath($2) -l$3${TCL_TRIM_DOTS}\"" 92 | ], [ 93 | eval "$1=\"-L[]CygPath($2) -l$3${PACKAGE_VERSION}\"" 94 | ]) 95 | AC_SUBST($1)]) 96 | 97 | dnl Local Variables: 98 | dnl mode: autoconf 99 | dnl End: 100 | -------------------------------------------------------------------------------- /doc/tdbc_sqlite3.n: -------------------------------------------------------------------------------- 1 | '\" 2 | .\" tdbc_sqlite3.n -- 3 | .\" 4 | .\" Copyright (c) 2008 by Kevin B. Kenny. 5 | .\" 6 | .\" See the file "license.terms" for information on usage and redistribution of 7 | .\" this file, and for a DISCLAIMER OF ALL WARRANTIES. 8 | .\" .so man.macros 9 | .if t .wh -1.3i ^B 10 | .nr ^l \n(.l 11 | .ad b 12 | .\" # BS - start boxed text 13 | .\" # ^y = starting y location 14 | .\" # ^b = 1 15 | .de BS 16 | .br 17 | .mk ^y 18 | .nr ^b 1u 19 | .if n .nf 20 | .if n .ti 0 21 | .if n \l'\\n(.lu\(ul' 22 | .if n .fi 23 | .. 24 | .\" # BE - end boxed text (draw box now) 25 | .de BE 26 | .nf 27 | .ti 0 28 | .mk ^t 29 | .ie n \l'\\n(^lu\(ul' 30 | .el \{\ 31 | .\" Draw four-sided box normally, but don't draw top of 32 | .\" box if the box started on an earlier page. 33 | .ie !\\n(^b-1 \{\ 34 | \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' 35 | .\} 36 | .el \}\ 37 | \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' 38 | .\} 39 | .\} 40 | .fi 41 | .br 42 | .nr ^b 0 43 | .. 44 | .\" # CS - begin code excerpt 45 | .de CS 46 | .RS 47 | .nf 48 | .ta .25i .5i .75i 1i 49 | .. 50 | .\" # CE - end code excerpt 51 | .de CE 52 | .fi 53 | .RE 54 | .. 55 | .TH "tdbc::sqlite3" n 8.6 Tcl "Tcl Database Connectivity" 56 | .BS 57 | .SH "NAME" 58 | tdbc::sqlite3 \- TDBC driver for the SQLite3 database manager 59 | .SH "SYNOPSIS" 60 | package require \fBtdbc::sqlite3 1.0\fR 61 | .sp 62 | \fBtdbc::sqlite3::connection create\fR \fIdb\fR \fIfileName\fR ?\fI-option value...\fR? 63 | .BE 64 | .SH "DESCRIPTION" 65 | .PP 66 | The \fBtdbc::sqlite3\fR driver provides a database interface that conforms 67 | to Tcl DataBase Connectivity (TDBC) and allows a Tcl script to connect 68 | to a SQLite3 database. It is also provided 69 | as a worked example of how to write a database driver in Tcl, so that 70 | driver authors have a starting point for further development. 71 | .PP 72 | Connection to a SQLite3 database is established by invoking 73 | \fBtdbc::sqlite3::connection create\fR, passing it a string to be used 74 | as the connection handle followed by the file name of 75 | the database. The side effect of \fBtdbc::sqlite3::connection 76 | create\fR is to create a new database connection.. 77 | As an alternative, \fBtdbc::sqlite::connection new\fR may be used to create 78 | a database connection with an automatically assigned name. The return value 79 | from \fBtdbc::sqlite::connection new\fR is the name that was chosen for the 80 | connection handle. See 81 | \fBtdbc::connection(n)\fR for the details of how to use the connection 82 | to manipulate a database. 83 | .SH "CONFIGURATION OPTIONS" 84 | .PP 85 | The standard configuration options \fB-encoding\fR, \fB-isolation\fR, 86 | \fB-readonly\fR and \fB-timeout\fR are all recognized, both on 87 | \fBtdbc::sqlite3::connection create\fR and on the \fBconfigure\fR 88 | method of the resulting connection. 89 | .PP 90 | Since the encoding of a SQLite3 database is always well known, the 91 | \fB-encoding\fR option accepts only \fButf-8\fR as an encoding and 92 | always returns \fButf-8\fR for an encoding. The actual encoding may be 93 | set using a SQLite3 \fBPRAGMA\fR statement when creating a new 94 | database. 95 | .PP 96 | Only the isolation levels \fBreaduncommitted\fR and \fBserializable\fR 97 | are implemented. Other isolation levels are promoted to 98 | \fBserializable\fR. 99 | .PP 100 | The \fB-readonly\fR flag is not implemented. \fB-readonly 0\fR is 101 | accepted silently, while \fB-readonly 1\fR reports an error. 102 | .SH "BUGS" 103 | If any column name is not unique among the columns in a result set, the 104 | results of \fB-as dicts\fR returns will be missing all but the rightmost 105 | of the duplicated columns. This limitation can be worked around by adding 106 | appropriate \fBAS\fR clauses to \fBSELECT\fR statements to ensure that 107 | all returned column names are unique. Plans are to fix this bug by using 108 | a C implementation of the driver, which will also improve performance 109 | significantly. 110 | .SH "SEE ALSO" 111 | tdbc(n), tdbc::connection(n), tdbc::resultset(n), tdbc::statement(n) 112 | .SH "KEYWORDS" 113 | TDBC, SQL, SQLite3, database, connectivity, connection 114 | .SH "COPYRIGHT" 115 | Copyright (c) 2008 by Kevin B. Kenny. 116 | .\" Local Variables: 117 | .\" mode: nroff 118 | .\" End: 119 | .\" 120 | -------------------------------------------------------------------------------- /configure.in: -------------------------------------------------------------------------------- 1 | #!/bin/bash -norc 2 | dnl This file is an input file used by the GNU "autoconf" program to 3 | dnl generate the file "configure", which is run during Tcl installation 4 | dnl to configure the system for the local environment. 5 | # 6 | # RCS: @(#) $Id: configure.in,v 1.48 2008/11/05 00:13:00 hobbs Exp $ 7 | 8 | AC_INIT([tdbcsqlite3], [1.0.0]) 9 | 10 | #-------------------------------------------------------------------- 11 | # Call TEA_INIT as the first TEA_ macro to set up initial vars. 12 | # This will define a ${TEA_PLATFORM} variable == "unix" or "windows" 13 | # as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. 14 | #-------------------------------------------------------------------- 15 | 16 | TEA_INIT([3.9]) 17 | AC_CONFIG_AUX_DIR(tclconfig) 18 | 19 | #-------------------------------------------------------------------- 20 | # Load the tclConfig.sh file 21 | #-------------------------------------------------------------------- 22 | 23 | TEA_PATH_TCLCONFIG 24 | TEA_LOAD_TCLCONFIG 25 | 26 | #---------------------------------------------------------------------- 27 | # Load the tdbcConfig.sh file 28 | #---------------------------------------------------------------------- 29 | 30 | TEA_PATH_CONFIG(tdbc) 31 | TEA_LOAD_CONFIG(tdbc) 32 | AC_SUBST(TDBC_VERSION) 33 | AC_SUBST(tdbc_BIN_DIR) 34 | AC_SUBST(TDBC_LIB_FILE) 35 | 36 | #----------------------------------------------------------------------- 37 | # Handle the --prefix=... option by defaulting to what Tcl gave. 38 | # Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER. 39 | #----------------------------------------------------------------------- 40 | 41 | TEA_PREFIX 42 | 43 | AC_SUBST(TCL_VERSION) 44 | AC_SUBST(TCL_MAJOR_VERSION) 45 | AC_SUBST(TCL_MINOR_VERSION) 46 | 47 | #----------------------------------------------------------------------- 48 | # Specify the C source files to compile in TEA_ADD_SOURCES, 49 | # public headers that need to be installed in TEA_ADD_HEADERS, 50 | # stub library C source files to compile in TEA_ADD_STUB_SOURCES, 51 | # and runtime Tcl library files in TEA_ADD_TCL_SOURCES. 52 | # This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS 53 | # and PKG_TCL_SOURCES. 54 | #----------------------------------------------------------------------- 55 | 56 | TEA_ADD_TCL_SOURCES([library/tdbcsqlite3.tcl]) 57 | 58 | #-------------------------------------------------------------------- 59 | # A few miscellaneous platform-specific items: 60 | # 61 | # Define a special symbol for Windows (BUILD_sample in this case) so 62 | # that we create the export library with the dll. 63 | # 64 | # Windows creates a few extra files that need to be cleaned up. 65 | # You can add more files to clean if your extension creates any extra 66 | # files. 67 | # 68 | # TEA_ADD_* any platform specific compiler/build info here. 69 | #-------------------------------------------------------------------- 70 | 71 | # Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure 72 | # and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var. 73 | #CLEANFILES="pkgIndex.tcl" 74 | if test "${TEA_PLATFORM}" = "windows" ; then 75 | AC_DEFINE(BUILD_sample, 1, [Build windows export dll]) 76 | CLEANFILES="$CLEANFILES *.lib *.dll *.exp *.ilk *.pdb vc*.pch" 77 | else 78 | # Ensure no empty else clauses 79 | : 80 | fi 81 | AC_SUBST(CLEANFILES) 82 | 83 | #-------------------------------------------------------------------- 84 | # Determine the name of the tclsh and/or wish executables in the 85 | # Tcl and Tk build directories or the location they were installed 86 | # into. These paths are used to support running test cases only, 87 | # the Makefile should not be making use of these paths to generate 88 | # a pkgIndex.tcl file or anything else at extension build time. 89 | #-------------------------------------------------------------------- 90 | 91 | TEA_PROG_TCLSH 92 | 93 | #-------------------------------------------------------------------- 94 | # Finally, substitute all of the various values into the Makefile. 95 | # You may alternatively have a special pkgIndex.tcl.in or other files 96 | # which require substituting th AC variables in. Include these here. 97 | #-------------------------------------------------------------------- 98 | 99 | AC_OUTPUT([Makefile pkgIndex.tcl]) 100 | 101 | # This is a comment added to force the 'execute' permission to update 102 | # in the Fossil repository. 103 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 2012-11-14 Donal K. Fellows 2 | 3 | * configure.in: Added configuration code to allow `make test` to 4 | * Makefile.in: run against an uninstalled 'tdbc' package. 5 | * configure: autoconf-2.68 6 | *** UPGRADED THE AUTOCONF VERSION IN USE *** 7 | 8 | 2012-11-08 Don Porter 9 | 10 | * configure.in: 11 | * README: 12 | * library/tdbcsqlite3.tcl: 13 | Advanced version number to 1.0.0. 14 | * configure: autoconf-2.59 15 | 16 | 2012-09-24 Harald Oehlmann 17 | 18 | * tdbcsqlite3/win/makefile.vc: Get DOTVERSION from file configure.in. 19 | * tdbcsqlite3/win/nmakehelp.c: Copied from tcl Checkin [8be494c5ee]: 20 | Let "nmakehlp -V" start searching digits after the found match 21 | (nijtmans). 22 | 23 | 2012-08-17 Jan Nijtmans 24 | 25 | * win/nmakehlp.c: Add "-V" option, in order to be able 26 | to detect partial version numbers. 27 | 28 | 2012-07-26 Jan Nijtmans 29 | 30 | * tclconfig/install-sh: Update to latest TEA 31 | * tclconfig/tcl.m4: 32 | * configure: autoconf-2.59 33 | 34 | 2012-05-07 Kevin B. Kenny 35 | 36 | * library/tdbcsqlite.tcl: Revised the syntax of the 'variable' 37 | command to avoid tripping over the 38 | Tcl core changes made for TIP 380. 39 | 40 | 2011-09-19 Kevin B. Kenny 41 | 42 | * library/tdbcsqlite3.tcl: Reworked handling of the end of results 43 | to avoid a bug where an empty result set at the end of the results 44 | would crash in 'allrows' or 'foreach'. Thanks to Colin McCormack 45 | for reporting the bug and providing a test case. 46 | * tests/tdbcsqlite.tcl: Added a test case for the above bug, 47 | observed to fail without the above change and pass with it. 48 | 49 | 2011-07-19 Kevin B. Kenny 50 | 51 | * configure.in: 52 | * README: 53 | * library/tdbcsqlite3.tcl: 54 | Advanced version number to 1.0b17. 55 | * configure: autoconf-2.59 56 | 57 | 2011-07-18 Don Porter 58 | 59 | * configure.in: Update to latest TEA 3.9 revisions. 60 | * Makefile.in: 61 | * tclconfig/*: 62 | 63 | * configure: autoconf-2.59 64 | 65 | 2011-04-12 Kevin B. Kenny 66 | 67 | * library/tdbcsqlite3.tcl ([resultset nextresults]): 68 | Corrected a bug in the handling of multiple result 69 | sets when one or more is empty. 70 | * tests/tdbcsqlite3.test (tdbc::sqlite3-30.6): 71 | Added a test case for the above bug. 72 | 73 | 2011-02-20 Kevin B. Kenny 74 | 75 | * tests/tdbcsqlite3.test (tdbc::sqlite3-30.[45]): 76 | Added tests for [foreach] and [allrows] against 77 | multiple result sets. 78 | 79 | 2011-01-26 Kevin B. Kenny 80 | 81 | * doc/tdbc_sqlite3.n: 82 | Added empty comment at the start of each manpage because 'man' 83 | interprets comments there as directives. Thanks to Konstantin 84 | Kohmoutov for reporting and diagnosing this error. 85 | 86 | 2010-09-03 Kevin B. Kenny 87 | 88 | * Makefile.in: Added a semicolon to the end of the -load option 89 | on 'make test'. Without it, msys make changes all 90 | the forward slashes in the -load option to backslashes. 91 | 92 | * library/tdbcsqlite3.tcl: 93 | * tests/tdbcsqlite3.test: 94 | Changed 'keySequence' in 'foreignkeys' to 95 | 'ordinalPosition' for consistency with 'primarykeys'. 96 | 97 | * configure.in: 98 | * README: 99 | * library/tdbcsqlite3.tcl: 100 | * tclconfig/: Upgraded the build to use TEA 3.9. 101 | Advanced version number to 1.0b16. 102 | 103 | 2010-06-19 Kevin B. Kenny 104 | 105 | * tdbcsqlite3.tcl: Added 'primarykeys' and 'foreignkeys' 106 | * tdbcsqlite3.test: methods to the 'connection' object. Added 107 | test cases for these methods. 108 | 109 | 2010-05-10 Kevin B. Kenny 110 | 111 | * aclocal.m4: Synchronized with 'tdbc'. 112 | * configure.in: Advanced version to 1.0b15. Advanced TEA to 3.7. 113 | * library/tdbcsqlite3.tcl: 114 | Advanced version to 1.0b15. 115 | * README: Advanced version to 1.0b15. 116 | * tclconfig/: Advanced TEA to 3.7. 117 | * configure: autoconf-2.59 118 | 119 | 2009-10-26 Kevin B. Kenny 120 | 121 | * README: Advanced version number to 1.0b14. 122 | * configure.in: 123 | * library/tdbcsqlite3.tcl: 124 | * configure: autoconf 2.59 125 | 126 | * tests/tdbcsqlite3.test: Added test cases (known bugs) for 127 | duplicate column names in results. 128 | * doc/tdbcsqlite3.n: Added a BUGS section documenting the 129 | known problem with duplicate column 130 | names. 131 | 132 | 2009-09-29 Kevin B. Kenny 133 | 134 | * README: Advanced version number to 1.0b13 135 | * configure.in: 136 | * library/tdbcsqlite3.tcl: 137 | * configure: autoconf-2.59 138 | 139 | 140 | 2009-07-03 Kevin B. Kenny 141 | 142 | * tempTest.tcl (removed): Deleted obsolete test harness; 143 | this package has used proper tcltest 144 | testing for months. 145 | 146 | * README: Advanced version number to 1.0b12 147 | * configure.in: 148 | * library/tdbcsqlite3.tcl: 149 | * configure: autoconf-2.59 150 | 151 | 2009-05-29 Kevin B. Kenny 152 | 153 | * README: Advanced version number to 1.0b11 154 | * configure.in: 155 | * library/tdbcsqlite3.tcl: 156 | * configure: autoconf-2.59 157 | 158 | 2009-04-19 Kevin B. Kenny 159 | 160 | * doc/tdbc_sqlite3.n: Added missing documentation for 'new' 161 | constructors. 162 | 163 | 2009-04-18 Kevin B. Kenny 164 | 165 | * tests/tdbcsqlite3.test: Changed the 'invalid path name' to a 166 | path name that is more likely actually 167 | to be invalid. Changed the tests for 168 | inappropriate access to an array variable 169 | not to expect failure. 170 | * doc/tdbc_sqlite3.n: Made changes so that NROFF formatting matches 171 | the Tcl standard. 172 | 173 | 2008-04-16 Kevin B. Kenny 174 | 175 | * README: Advanced version number to 1.0b10 176 | * configure.in: 177 | * library/tdbcsqlite3.tcl: 178 | * configure: autoconf-2.59 179 | 180 | 2008-02-16 Kevin B. Kenny 181 | 182 | * README: Advanced version number to 1.0b9 183 | * configure.in: 184 | * library/tdbcsqlite3.tcl: 185 | * configure: autoconf-2.59 186 | 187 | 2008-01-31 Kevin B. Kenny 188 | 189 | * README: Advanced version number to 1.0b7 190 | * configure.in: 191 | * configure: autoconf-2.59 192 | * library/tdbcsqlite3.tcl: Changed ::errorCode returns to 193 | follow TDBC [try]-friendly convention 194 | TDBC errorClass sqlState driver detail 195 | 196 | 2008-01-05 Kevin B. Kenny 197 | 198 | * README: Advanced version number to 1.0b6 199 | * configure.in: 200 | * library/tdbcsqlite3.tcl: 201 | * configure: autoconf-2.59 202 | 203 | 2008-01-04 Kevin B. Kenny 204 | 205 | * Makefile.in: Changes to make 'make dist' work 206 | * README: Advanced version number to 1.0b5 207 | * configure.in: 208 | * library/tdbcsqlite3.tcl: 209 | * configure: autoconf-2.59 210 | 211 | 2008-12-30 Kevin B. Kenny 212 | 213 | * README: Advanced version number to 1.0b4 214 | * configure.in: 215 | * library/tdbcsqlite3.tcl: 216 | * configure: autoconf-2.59 217 | 218 | 2008-12-08 Kevin B. Kenny 219 | 220 | * doc/tdbcsqlite3.n: Added a man page for the driver. 221 | * library/tdbcsqlite3.tcl (configure): Added a configurator for 222 | * tests/tdbcsqlite3.test (tdbc::sqlite3-19.*): SQLite3 connections and 223 | rudimentary test cases for connection configuration. 224 | 225 | 2008-12-07 Kevin B. Kenny 226 | 227 | * Makefile.in: 228 | * aclocal.m4: 229 | * configure.in: 230 | * library/tdbcsqlite3.tcl: 231 | * license.terms: 232 | * pkgIndex.tcl.in: 233 | * tclconfig/*: 234 | * tests/all.tcl: 235 | * tests/tdbcsqlite3.test: 236 | Added infrastructure needed to make tdbc::sqlite3 237 | a TEA-compliant module. Advanced revision number to 1.0b1 in 238 | preparation for release. 239 | 240 | 2008-06-11 Kevin B. Kenny 241 | 242 | * library/tdbcsqlite3.tcl: Split [$resultset nextrow] into two 243 | primitive methods: [$resultset nextlist] and [$resultset nextdict]. 244 | 245 | 2008-05-13 Kevin B. Kenny 246 | 247 | * tests/tdbcsqlite3.test: Added cleanup for the test for 248 | failing to open a database, in case we actually open it successfully. 249 | 250 | 2008-05-10 Kevin B. Kenny 251 | 252 | * ChangeLog: Added a change log. 253 | * library/tdbcsqlite3.tcl: Added the 'columns' and 'tables' 254 | methods for schema introspection. 255 | * tests/tdbcsqlite3.test: Removed some superfluous debugging print. 256 | Renumbered tdbcsqlite3-9.9. Corrected the tests for column 257 | types to match SQLite's view of the world. 258 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | # Makefile.in -- 2 | # 3 | # This file is a Makefile for Sample TEA Extension. If it has the name 4 | # "Makefile.in" then it is a template for a Makefile; to generate the 5 | # actual Makefile, run "./configure", which is a configuration script 6 | # generated by the "autoconf" program (constructs like "@foo@" will get 7 | # replaced in the actual Makefile. 8 | # 9 | # Copyright (c) 1999 Scriptics Corporation. 10 | # Copyright (c) 2002-2005 ActiveState Corporation. 11 | # 12 | # See the file "license.terms" for information on usage and redistribution 13 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 | # 15 | # RCS: @(#) $Id: Makefile.in,v 1.64 2007/10/23 22:08:06 hobbs Exp $ 16 | 17 | #======================================================================== 18 | # Add additional lines to handle any additional AC_SUBST cases that 19 | # have been added in a customized configure script. 20 | #======================================================================== 21 | 22 | #SAMPLE_NEW_VAR = @SAMPLE_NEW_VAR@ 23 | 24 | #======================================================================== 25 | # Nothing of the variables below this line should need to be changed. 26 | # Please check the TARGETS section below to make sure the make targets 27 | # are correct. 28 | #======================================================================== 29 | 30 | #======================================================================== 31 | # The names of the source files is defined in the configure script. 32 | # The object files are used for linking into the final library. 33 | # This will be used when a dist target is added to the Makefile. 34 | # It is not important to specify the directory, as long as it is the 35 | # $(srcdir) or in the generic, win or unix subdirectory. 36 | #======================================================================== 37 | 38 | #======================================================================== 39 | # PKG_TCL_SOURCES identifies Tcl runtime files that are associated with 40 | # this package that need to be installed, if any. 41 | #======================================================================== 42 | 43 | PKG_TCL_SOURCES = @PKG_TCL_SOURCES@ 44 | 45 | #======================================================================== 46 | # "PKG_LIB_FILE" refers to the library (dynamic or static as per 47 | # configuration options) composed of the named objects. 48 | #======================================================================== 49 | 50 | PKG_LIB_FILE = @PKG_LIB_FILE@ 51 | PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@ 52 | 53 | lib_BINARIES = $(PKG_LIB_FILE) 54 | BINARIES = $(lib_BINARIES) 55 | 56 | SHELL = @SHELL@ 57 | 58 | srcdir = @srcdir@ 59 | prefix = @prefix@ 60 | exec_prefix = @exec_prefix@ 61 | 62 | bindir = @bindir@ 63 | libdir = @libdir@ 64 | includedir = @includedir@ 65 | datarootdir = @datarootdir@ 66 | datadir = @datadir@ 67 | mandir = @mandir@ 68 | 69 | DESTDIR = 70 | 71 | PKG_DIR = $(PACKAGE_NAME)-$(PACKAGE_VERSION) 72 | pkgdatadir = $(datadir)/$(PKG_DIR) 73 | pkglibdir = $(libdir)/$(PKG_DIR) 74 | pkgincludedir = $(includedir)/$(PKG_DIR) 75 | tmdir = $(libdir)/tcl$(TCL_MAJOR_VERSION)/$(TCL_VERSION) 76 | pkgslash = `echo $(PACKAGE_NAME) | sed s=tdbc=tdbc/=` 77 | pkgtmdir = $(tmdir)/tdbc 78 | pkgtmfile = $(tmdir)/$(pkgslash)-$(PACKAGE_VERSION).tm 79 | 80 | top_builddir = . 81 | 82 | INSTALL_OPTIONS = 83 | INSTALL = $(SHELL) $(srcdir)/tclconfig/install-sh -c ${INSTALL_OPTIONS} 84 | INSTALL_DATA_DIR = ${INSTALL} -d -m 755 85 | INSTALL_PROGRAM = ${INSTALL} -m 555 86 | INSTALL_DATA = ${INSTALL} -m 444 87 | INSTALL_SCRIPT = ${INSTALL_PROGRAM} 88 | INSTALL_LIBRARY = ${INSTALL_DATA} 89 | 90 | TCL_VERSION = @TCL_VERSION@ 91 | TCL_MAJOR_VERSION = @TCL_MAJOR_VERSION@ 92 | 93 | PACKAGE_NAME = @PACKAGE_NAME@ 94 | PACKAGE_VERSION = @PACKAGE_VERSION@ 95 | #TCL_DEFS = @TCL_DEFS@ 96 | TCL_BIN_DIR = @TCL_BIN_DIR@ 97 | TCL_SRC_DIR = @TCL_SRC_DIR@ 98 | #TK_BIN_DIR = @TK_BIN_DIR@ 99 | #TK_SRC_DIR = @TK_SRC_DIR@ 100 | 101 | TDBC_VERSION = @TDBC_VERSION@ 102 | TDBC_BIN_DIR = @tdbc_BIN_DIR@ 103 | TDBC_LIB_FILE = @TDBC_LIB_FILE@ 104 | 105 | # Not used, but retained for reference of what libs Tcl required 106 | #TCL_LIBS = @TCL_LIBS@ 107 | 108 | #======================================================================== 109 | # TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our 110 | # package without installing. The other environment variables allow us 111 | # to test against an uninstalled Tcl. Add special env vars that you 112 | # require for testing here (like TCLX_LIBRARY). 113 | #======================================================================== 114 | 115 | EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR) 116 | #EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR) 117 | TCLLIBPATH = $(top_builddir) 118 | TCLSH_ENV = TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library` 119 | PKG_ENV = PATH="$(EXTRA_PATH):$(PATH)" \ 120 | TCLLIBPATH="$(TCLLIBPATH)" 121 | 122 | TCLSH_PROG = @TCLSH_PROG@ 123 | TCLSH = $(PKG_ENV) $(TCLSH_ENV) $(TCLSH_PROG) 124 | 125 | #WISH_ENV = TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library` 126 | #WISH_PROG = @WISH_PROG@ 127 | #WISH = $(PKG_ENV) $(TCLSH_ENV) $(WISH_ENV) $(WISH_PROG) 128 | 129 | SHARED_BUILD = @SHARED_BUILD@ 130 | 131 | INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@ 132 | 133 | # Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile 134 | CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl 135 | CLEANFILES = @CLEANFILES@ 136 | 137 | #======================================================================== 138 | # Start of user-definable TARGETS section 139 | #======================================================================== 140 | 141 | #======================================================================== 142 | # TEA TARGETS. Please note that the "libraries:" target refers to platform 143 | # independent files, and the "binaries:" target inclues executable programs and 144 | # platform-dependent libraries. Modify these targets so that they install 145 | # the various pieces of your package. The make and install rules 146 | # for the BINARIES that you specified above have already been done. 147 | #======================================================================== 148 | 149 | all: libraries doc 150 | 151 | libraries: 152 | 153 | #======================================================================== 154 | # Your doc target should differentiate from doc builds (by the developer) 155 | # and doc installs (see install-doc), which just install the docs on the 156 | # end user machine when building from source. 157 | #======================================================================== 158 | 159 | doc: 160 | @echo "If you have documentation to create, place the commands to" 161 | @echo "build the docs in the 'doc:' target. For example:" 162 | @echo " xml2nroff sample.xml > sample.n" 163 | @echo " xml2html sample.xml > sample.html" 164 | 165 | install: all install-binaries install-libraries install-doc 166 | 167 | install-binaries: install-lib-binaries 168 | 169 | #======================================================================== 170 | # This rule installs platform-independent files, such as header files. 171 | # The list=...; for p in $$list handles the empty list case x-platform. 172 | #======================================================================== 173 | 174 | install-libraries: libraries 175 | 176 | #======================================================================== 177 | # Install documentation. Unix manpages should go in the $(mandir) 178 | # directory. 179 | #======================================================================== 180 | 181 | install-doc: doc 182 | @$(INSTALL_DATA_DIR) $(DESTDIR)$(mandir)/mann 183 | @echo "Installing documentation in $(DESTDIR)$(mandir)" 184 | @list='$(srcdir)/doc/*.n'; for i in $$list; do \ 185 | echo "Installing $$i"; \ 186 | rm -f $(DESTDIR)$(mandir)/mann/`basename $$i`; \ 187 | $(INSTALL_DATA) $$i $(DESTDIR)$(mandir)/mann ; \ 188 | done 189 | 190 | # If the semicolon is omitted after the [list source ...], then 191 | # at least one version of msys make replaces the slashes in the 192 | # $(srcdir)/library/tdbcsqlite3.tcl path with backslashes, causing 193 | # the [package ifneeded] to fail. Leave it in, even though it's 194 | # spurious. 195 | test: libraries 196 | $(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) -load \ 197 | "package ifneeded tdbc::sqlite3 $(PACKAGE_VERSION) \ 198 | [list source `@CYGPATH@ $(srcdir)/library/tdbcsqlite3.tcl`];\ 199 | package ifneeded tdbc ${TDBC_VERSION} \ 200 | [list source `@CYGPATH@ $(TDBC_BIN_DIR)/tdbc.tcl`]\;[list load `@CYGPATH@ $(TDBC_BIN_DIR)/$(TDBC_LIB_FILE)` tdbc]" 201 | 202 | shell: libraries 203 | @$(TCLSH) $(SCRIPT) 204 | 205 | gdb: 206 | $(TCLSH_ENV) gdb $(TCLSH_PROG) $(SCRIPT) 207 | 208 | depend: 209 | 210 | #======================================================================== 211 | # Distribution creation 212 | # You may need to tweak this target to make it work correctly. 213 | #======================================================================== 214 | 215 | #COMPRESS = tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar 216 | COMPRESS = tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR) 217 | DIST_ROOT = /tmp/dist 218 | DIST_DIR = $(DIST_ROOT)/$(PKG_DIR) 219 | 220 | dist-clean: 221 | rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.* 222 | 223 | dist: dist-clean 224 | mkdir -p $(DIST_DIR) 225 | cp -p $(srcdir)/ChangeLog $(srcdir)/README* $(srcdir)/license* \ 226 | $(srcdir)/aclocal.m4 $(srcdir)/configure $(srcdir)/*.in \ 227 | $(DIST_DIR)/ 228 | chmod 664 $(DIST_DIR)/Makefile.in $(DIST_DIR)/aclocal.m4 229 | chmod 775 $(DIST_DIR)/configure $(DIST_DIR)/configure.in 230 | 231 | for i in $(srcdir)/*.[ch]; do \ 232 | if [ -f $$i ]; then \ 233 | cp -p $$i $(DIST_DIR)/ ; \ 234 | fi; \ 235 | done; 236 | 237 | mkdir $(DIST_DIR)/tclconfig 238 | cp $(srcdir)/tclconfig/install-sh $(srcdir)/tclconfig/tcl.m4 \ 239 | $(DIST_DIR)/tclconfig/ 240 | chmod 664 $(DIST_DIR)/tclconfig/tcl.m4 241 | chmod +x $(DIST_DIR)/tclconfig/install-sh 242 | 243 | mkdir $(DIST_DIR)/doc 244 | cp -p $(srcdir)/doc/tdbc_sqlite3.n $(DIST_DIR)/doc/ 245 | 246 | mkdir $(DIST_DIR)/library 247 | cp -p $(srcdir)/library/tdbcsqlite3.tcl $(DIST_DIR)/library/ 248 | 249 | mkdir $(DIST_DIR)/tests 250 | cp -p $(srcdir)/tests/all.tcl $(srcdir)/tests/tdbcsqlite3.test \ 251 | $(DIST_DIR)/tests/ 252 | 253 | mkdir $(DIST_DIR)/win 254 | cp -p $(srcdir)/win/makefile.vc $(srcdir)/win/nmakehlp.c \ 255 | $(srcdir)/win/rules.vc $(DIST_DIR)/win/ 256 | 257 | (cd $(DIST_ROOT); $(COMPRESS);) 258 | 259 | #======================================================================== 260 | # End of user-definable section 261 | #======================================================================== 262 | 263 | #======================================================================== 264 | # Don't modify the file to clean here. Instead, set the "CLEANFILES" 265 | # variable in configure.in 266 | #======================================================================== 267 | 268 | clean: 269 | -rm -f *.core *.core 270 | -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) 271 | 272 | distclean: clean 273 | -rm -f *.tab.c 274 | -rm -f $(CONFIG_CLEAN_FILES) 275 | -rm -f config.cache config.log config.status 276 | 277 | #======================================================================== 278 | # Install binary object libraries. On Windows this includes both .dll and 279 | # .lib files. Because the .lib files are not explicitly listed anywhere, 280 | # we need to deduce their existence from the .dll file of the same name. 281 | # Library files go into the lib directory. 282 | # In addition, this will generate the pkgIndex.tcl 283 | # file in the install location (assuming it can find a usable tclsh shell) 284 | # 285 | # You should not have to modify this target. 286 | #======================================================================== 287 | 288 | install-lib-binaries: 289 | @$(INSTALL_DATA_DIR) $(DESTDIR)$(pkgtmdir) 290 | $(INSTALL_DATA) $(srcdir)/library/tdbcsqlite3.tcl \ 291 | $(DESTDIR)$(pkgtmfile) 292 | 293 | Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status 294 | cd $(top_builddir) \ 295 | && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status 296 | 297 | uninstall-binaries: 298 | list='$(PKG_TCL_SOURCES)'; for p in $$list; do \ 299 | p=`basename $$p`; \ 300 | rm -f $(DESTDIR)$(pkglibdir)/$$p; \ 301 | done 302 | 303 | .PHONY: all clean distclean doc install libraries test 304 | 305 | # Tell versions [3.59,3.63) of GNU make to not export all variables. 306 | # Otherwise a system limit (for SysV at least) may be exceeded. 307 | .NOEXPORT: 308 | -------------------------------------------------------------------------------- /win/makefile.vc: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------- -*- makefile -*- 2 | # makefile.vc -- 3 | # 4 | # Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) 5 | # 6 | # This makefile is based upon the Tcl 8.6 Makefile.vc and modified to 7 | # make it suitable as a general package makefile. Look for the word EDIT 8 | # which marks sections that may need modification. As a minumum you will 9 | # need to change the PROJECT, DOTVERSION and DLLOBJS variables to values 10 | # relevant to your package. 11 | # 12 | # See the file "license.terms" for information on usage and redistribution 13 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 | # 15 | # Copyright (c) 1995-1996 Sun Microsystems, Inc. 16 | # Copyright (c) 1998-2000 Ajuba Solutions. 17 | # Copyright (c) 2001-2005 ActiveState Corporation. 18 | # Copyright (c) 2001-2004 David Gravereaux. 19 | # Copyright (c) 2003-2008 Pat Thoyts. 20 | #------------------------------------------------------------------------------ 21 | 22 | # Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or 23 | # VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir) 24 | !if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR) 25 | MSG = ^ 26 | You need to run vcvars32.bat from Developer Studio or setenv.bat from the^ 27 | Platform SDK first to setup the environment. Jump to this line to read^ 28 | the build instructions. 29 | !error $(MSG) 30 | !endif 31 | 32 | #------------------------------------------------------------------------------ 33 | # HOW TO USE this makefile: 34 | # 35 | # 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the 36 | # environment. This is used as a check to see if vcvars32.bat had been 37 | # run prior to running nmake or during the installation of Microsoft 38 | # Visual C++, MSVCDir had been set globally and the PATH adjusted. 39 | # Either way is valid. 40 | # 41 | # You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin 42 | # directory to setup the proper environment, if needed, for your 43 | # current setup. This is a needed bootstrap requirement and allows the 44 | # swapping of different environments to be easier. 45 | # 46 | # 2) To use the Platform SDK (not expressly needed), run setenv.bat after 47 | # vcvars32.bat according to the instructions for it. This can also 48 | # turn on the 64-bit compiler, if your SDK has it. 49 | # 50 | # 3) Targets are: 51 | # all -- Builds everything. 52 | # -- Builds the project (eg: nmake sample) 53 | # test -- Builds and runs the test suite. 54 | # install -- Installs the built binaries and libraries to $(INSTALLDIR) 55 | # in an appropriate subdirectory. 56 | # clean/realclean/distclean -- varying levels of cleaning. 57 | # 58 | # 4) Macros usable on the commandline: 59 | # INSTALLDIR= 60 | # Sets where to install Tcl from the built binaries. 61 | # C:\Progra~1\Tcl is assumed when not specified. 62 | # 63 | # OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,symbols,unchecked,none 64 | # Sets special options for the core. The default is for none. 65 | # Any combination of the above may be used (comma separated). 66 | # 'none' will over-ride everything to nothing. 67 | # 68 | # loimpact = Adds a flag for how NT treats the heap to keep memory 69 | # in use, low. This is said to impact alloc performance. 70 | # msvcrt = Affects the static option only to switch it from 71 | # using libcmt(d) as the C runtime [by default] to 72 | # msvcrt(d). This is useful for static embedding 73 | # support. 74 | # nothreads = Turns off multithreading support (not recommended) 75 | # static = Builds a static library of the core instead of a 76 | # dll. The shell will be static (and large), as well. 77 | # pdbs = Build detached symbols for release builds. 78 | # profile = Adds profiling hooks. Map file is assumed. 79 | # symbols = Debug build. Links to the debug C runtime, disables 80 | # optimizations and creates pdb symbols files. 81 | # unchecked = Allows a symbols build to not use the debug 82 | # enabled runtime (msvcrt.dll not msvcrtd.dll 83 | # or libcmt.lib not libcmtd.lib). 84 | # 85 | # STATS=memdbg,compdbg,none 86 | # Sets optional memory and bytecode compiler debugging code added 87 | # to the core. The default is for none. Any combination of the 88 | # above may be used (comma separated). 'none' will over-ride 89 | # everything to nothing. 90 | # 91 | # memdbg = Enables the debugging memory allocator. 92 | # compdbg = Enables byte compilation logging. 93 | # 94 | # CHECKS=64bit,fullwarn,nodep,none 95 | # Sets special macros for checking compatability. 96 | # 97 | # 64bit = Enable 64bit portability warnings (if available) 98 | # fullwarn = Builds with full compiler and link warnings enabled. 99 | # Very verbose. 100 | # nodep = Turns off compatability macros to ensure Tk isn't 101 | # being built with deprecated functions. 102 | # 103 | # MACHINE=(ALPHA|AMD64|IA64|IX86) 104 | # Set the machine type used for the compiler, linker, and 105 | # resource compiler. This hook is needed to tell the tools 106 | # when alternate platforms are requested. IX86 is the default 107 | # when not specified. If the CPU environment variable has been 108 | # set (ie: recent Platform SDK) then MACHINE is set from CPU. 109 | # 110 | # TMP_DIR= 111 | # OUT_DIR= 112 | # Hooks to allow the intermediate and output directories to be 113 | # changed. $(OUT_DIR) is assumed to be 114 | # $(BINROOT)\(Release|Debug) based on if symbols are requested. 115 | # $(TMP_DIR) will de $(OUT_DIR)\ by default. 116 | # 117 | # TESTPAT= 118 | # Reads the tests requested to be run from this file. 119 | # 120 | # 5) Examples: 121 | # 122 | # Basic syntax of calling nmake looks like this: 123 | # nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]] 124 | # 125 | # Standard (no frills) 126 | # c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat 127 | # Setting environment for using Microsoft Visual C++ tools. 128 | # c:\tcl_src\win\>nmake -f makefile.vc all 129 | # c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl 130 | # 131 | # Building for Win64 132 | # c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat 133 | # Setting environment for using Microsoft Visual C++ tools. 134 | # c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL 135 | # Targeting Windows pre64 RETAIL 136 | # c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64 137 | # 138 | #------------------------------------------------------------------------------ 139 | #============================================================================== 140 | #------------------------------------------------------------------------------ 141 | 142 | !if !exist("makefile.vc") 143 | MSG = ^ 144 | You must run this makefile only from the directory it is in.^ 145 | Please `cd` to its location first. 146 | !error $(MSG) 147 | !endif 148 | 149 | #------------------------------------------------------------------------- 150 | # Project specific information (EDIT) 151 | # 152 | # You should edit this with the name and version of your project. This 153 | # information is used to generate the name of the package library and 154 | # it's install location. 155 | # 156 | # For example, the sample extension is going to build sample05.dll and 157 | # would install it into $(INSTALLDIR)\lib\sample05 158 | # 159 | # You need to specify the object files that need to be linked into your 160 | # binary here. 161 | # 162 | #------------------------------------------------------------------------- 163 | 164 | PROJECT = tdbcsqlite 165 | 166 | # Uncomment the following line if this is a Tk extension. 167 | #PROJECT_REQUIRES_TK=1 168 | !include "rules.vc" 169 | 170 | # nmakehelp -V will search the file for tag, skips until a 171 | # number and returns all character until a character not in [0-9.ab] 172 | # is read. 173 | 174 | !if [echo REM = This file is generated from Makefile.vc > versions.vc] 175 | !endif 176 | # get project version from row "AC_INIT([tdbcsqlite3], [1.0b17])" 177 | !if [echo DOTVERSION = \>> versions.vc] \ 178 | && [nmakehlp -V ..\configure.in tdbcsqlite3 >> versions.vc] 179 | !endif 180 | !include "versions.vc" 181 | 182 | VERSION = $(DOTVERSION:.=) 183 | STUBPREFIX = $(PROJECT)stub 184 | 185 | DLLOBJS = 186 | 187 | PRJSTUBOBJS = 188 | 189 | PRJHEADERS = 190 | 191 | #------------------------------------------------------------------------- 192 | # Target names and paths ( shouldn't need changing ) 193 | #------------------------------------------------------------------------- 194 | 195 | BINROOT = $(MAKEDIR) 196 | ROOT = $(MAKEDIR)\.. 197 | 198 | PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib 199 | PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) 200 | PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) 201 | 202 | PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib 203 | PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) 204 | 205 | ### Make sure we use backslash only. 206 | PRJ_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION) 207 | LIB_INSTALL_DIR = $(PRJ_INSTALL_DIR) 208 | BIN_INSTALL_DIR = $(PRJ_INSTALL_DIR) 209 | DOC_INSTALL_DIR = $(PRJ_INSTALL_DIR) 210 | SCRIPT_INSTALL_DIR = $(PRJ_INSTALL_DIR) 211 | INCLUDE_INSTALL_DIR = $(_TCLDIR)\include 212 | tmdir = $(_INSTALLDIR)\tcl$(TCL_MAJOR_VERSION)\$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) 213 | 214 | ### The following paths CANNOT have spaces in them. 215 | GENERICDIR = $(ROOT)\generic 216 | WINDIR = $(ROOT)\win 217 | LIBDIR = $(ROOT)\library 218 | DOCDIR = $(ROOT)\doc 219 | TOOLSDIR = $(ROOT)\tools 220 | COMPATDIR = $(ROOT)\compat 221 | 222 | #--------------------------------------------------------------------- 223 | # Compile flags 224 | #--------------------------------------------------------------------- 225 | 226 | !if !$(DEBUG) 227 | !if $(OPTIMIZING) 228 | ### This cranks the optimization level to maximize speed 229 | cdebug = $(OPTIMIZATIONS) 230 | !else 231 | cdebug = 232 | !endif 233 | !else if "$(MACHINE)" == "IA64" 234 | ### Warnings are too many, can't support warnings into errors. 235 | cdebug = -Zi -Od $(DEBUGFLAGS) 236 | !else 237 | cdebug = -Zi -WX $(DEBUGFLAGS) 238 | !endif 239 | 240 | ### Declarations common to all compiler options 241 | cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE 242 | cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ 243 | 244 | !if $(MSVCRT) 245 | !if $(DEBUG) && !$(UNCHECKED) 246 | crt = -MDd 247 | !else 248 | crt = -MD 249 | !endif 250 | !else 251 | !if $(DEBUG) && !$(UNCHECKED) 252 | crt = -MTd 253 | !else 254 | crt = -MT 255 | !endif 256 | !endif 257 | 258 | cflags = $(cflags) -DMODULE_SCOPE=extern 259 | 260 | !if !$(STATIC_BUILD) 261 | cflags = $(cflags) -DUSE_TCL_STUBS 262 | !if defined(TKSTUBLIB) 263 | cflags = $(cflags) -DUSE_TK_STUBS 264 | !endif 265 | !endif 266 | 267 | INCLUDES = $(TCL_INCLUDES) -I"$(WINDIR)" -I"$(GENERICDIR)" 268 | BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(INCLUDES) 269 | CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE 270 | TCL_CFLAGS = -DPACKAGE_NAME="\"$(PROJECT)\"" \ 271 | -DPACKAGE_VERSION="\"$(DOTVERSION)\"" \ 272 | -DBUILD_$(PROJECT) \ 273 | $(BASE_CFLAGS) $(OPTDEFINES) 274 | 275 | ### Stubs files should not be compiled with -GL 276 | STUB_CFLAGS = $(cflags) $(cdebug:-GL=) #$(TK_DEFINES) 277 | 278 | #--------------------------------------------------------------------- 279 | # Link flags 280 | #--------------------------------------------------------------------- 281 | 282 | !if $(DEBUG) 283 | ldebug = -debug 284 | !if $(MSVCRT) 285 | ldebug = $(ldebug) -nodefaultlib:msvcrt 286 | !endif 287 | !else 288 | ldebug = -release -opt:ref -opt:icf,3 289 | !endif 290 | 291 | ### Declarations common to all linker options 292 | lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug) 293 | 294 | !if $(PROFILE) 295 | lflags = $(lflags) -profile 296 | !endif 297 | 298 | !if $(ALIGN98_HACK) && !$(STATIC_BUILD) 299 | ### Align sections for PE size savings. 300 | lflags = $(lflags) -opt:nowin98 301 | !else if !$(ALIGN98_HACK) && $(STATIC_BUILD) 302 | ### Align sections for speed in loading by choosing the virtual page size. 303 | lflags = $(lflags) -align:4096 304 | !endif 305 | 306 | !if $(LOIMPACT) 307 | lflags = $(lflags) -ws:aggressive 308 | !endif 309 | 310 | dlllflags = $(lflags) -dll 311 | conlflags = $(lflags) -subsystem:console 312 | guilflags = $(lflags) -subsystem:windows 313 | !if !$(STATIC_BUILD) 314 | baselibs = $(TCLSTUBLIB) 315 | !if defined(TKSTUBLIB) 316 | baselibs = $(baselibs) $(TKSTUBLIB) 317 | !endif 318 | !endif 319 | 320 | # Avoid 'unresolved external symbol __security_cookie' errors. 321 | # c.f. http://support.microsoft.com/?id=894573 322 | !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" 323 | !if $(VCVERSION) > 1399 && $(VCVERSION) < 1500 324 | baselibs = $(baselibs) bufferoverflowU.lib 325 | !endif 326 | !endif 327 | 328 | #--------------------------------------------------------------------- 329 | # TclTest flags 330 | #--------------------------------------------------------------------- 331 | 332 | !if "$(TESTPAT)" != "" 333 | TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT) 334 | !endif 335 | 336 | #--------------------------------------------------------------------- 337 | # Project specific targets (EDIT) 338 | #--------------------------------------------------------------------- 339 | 340 | all: setup $(PROJECT) 341 | $(PROJECT): setup 342 | install: install-binaries install-docs 343 | install-binaries: install-lib-binaries 344 | 345 | test: setup $(PROJECT) 346 | @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) 347 | @set TCLLIBPATH=$(OUT_DIR_PATH:\=/) 348 | @set TDBC_LIBRARY=$(LIBDIR:\=/) 349 | @$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR) 350 | !if $(TCLINSTALL) 351 | @set PATH=$(_TCLDIR)\bin;$(PATH) 352 | !else 353 | @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) 354 | !endif 355 | $(DEBUGGER) $(TCLSH) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) 356 | 357 | shell: setup $(PROJECT) 358 | @set TCL_LIBRARY=$(TCL_LIBRARY:\=/) 359 | @set TDBC_LIBRARY=$(LIBDIR:\=/) 360 | !if $(TCLINSTALL) 361 | @set PATH=$(_TCLDIR)\bin;$(PATH) 362 | !else 363 | @set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH) 364 | !endif 365 | $(DEBUGGER) $(TCLSH) $(SCRIPT) 366 | 367 | setup: 368 | @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) 369 | @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) 370 | 371 | 372 | #--------------------------------------------------------------------- 373 | # Implicit rules 374 | #--------------------------------------------------------------------- 375 | 376 | {$(WINDIR)}.c{$(TMP_DIR)}.obj:: 377 | $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<< 378 | $< 379 | << 380 | 381 | {$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: 382 | $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<< 383 | $< 384 | << 385 | 386 | {$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: 387 | $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<< 388 | $< 389 | << 390 | 391 | {$(WINDIR)}.rc{$(TMP_DIR)}.res: 392 | $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \ 393 | -DCOMMAVERSION=$(DOTVERSION:.=,),0 \ 394 | -DDOTVERSION=\"$(DOTVERSION)\" \ 395 | -DVERSION=\"$(VERSION)$(SUFX)\" \ 396 | !if $(DEBUG) 397 | -d DEBUG \ 398 | !endif 399 | !if $(TCL_THREADS) 400 | -d TCL_THREADS \ 401 | !endif 402 | !if $(STATIC_BUILD) 403 | -d STATIC_BUILD \ 404 | !endif 405 | $< 406 | 407 | .SUFFIXES: 408 | .SUFFIXES:.c .rc 409 | 410 | #--------------------------------------------------------------------- 411 | # Installation. (EDIT) 412 | # 413 | # You may need to modify this section to reflect the final distribution 414 | # of your files and possibly to generate documentation. 415 | # 416 | #--------------------------------------------------------------------- 417 | 418 | install-lib-binaries: 419 | @echo Installing 'tdbcsqlite3.tcl' file to '$(tmdir)\tdbc\sqlite3-$(DOTVERSION).tm' 420 | @if not exist "$(tmdir)\tdbc" mkdir "$(tmdir)\tdbc" 421 | @if exist $(LIBDIR) $(COPY) $(LIBDIR)\tdbcsqlite3.tcl "$(tmdir)\tdbc\sqlite3-$(DOTVERSION).tm" 422 | 423 | install-docs: 424 | @echo Installing documentation files to '$(DOC_INSTALL_DIR)' 425 | @if exist $(DOCDIR) $(CPY) $(DOCDIR)\*.n "$(DOC_INSTALL_DIR)" 426 | 427 | #--------------------------------------------------------------------- 428 | # Clean up 429 | #--------------------------------------------------------------------- 430 | 431 | clean: 432 | @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) 433 | @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc 434 | @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i 435 | @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x 436 | @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch 437 | 438 | realclean: clean 439 | @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) 440 | 441 | distclean: realclean 442 | @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe 443 | @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj 444 | -------------------------------------------------------------------------------- /win/nmakehlp.c: -------------------------------------------------------------------------------- 1 | /* 2 | * ---------------------------------------------------------------------------- 3 | * nmakehlp.c -- 4 | * 5 | * This is used to fix limitations within nmake and the environment. 6 | * 7 | * Copyright (c) 2002 by David Gravereaux. 8 | * Copyright (c) 2006 by Pat Thoyts 9 | * 10 | * See the file "license.terms" for information on usage and redistribution of 11 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 | * ---------------------------------------------------------------------------- 13 | */ 14 | 15 | #define _CRT_SECURE_NO_DEPRECATE 16 | #include 17 | #define NO_SHLWAPI_GDI 18 | #define NO_SHLWAPI_STREAM 19 | #define NO_SHLWAPI_REG 20 | #include 21 | #pragma comment (lib, "user32.lib") 22 | #pragma comment (lib, "kernel32.lib") 23 | #pragma comment (lib, "shlwapi.lib") 24 | #include 25 | #include 26 | 27 | /* 28 | * This library is required for x64 builds with _some_ versions of MSVC 29 | */ 30 | #if defined(_M_IA64) || defined(_M_AMD64) 31 | #if _MSC_VER >= 1400 && _MSC_VER < 1500 32 | #pragma comment(lib, "bufferoverflowU") 33 | #endif 34 | #endif 35 | 36 | /* ISO hack for dumb VC++ */ 37 | #ifdef _MSC_VER 38 | #define snprintf _snprintf 39 | #endif 40 | 41 | 42 | 43 | /* protos */ 44 | 45 | static int CheckForCompilerFeature(const char *option); 46 | static int CheckForLinkerFeature(const char *option); 47 | static int IsIn(const char *string, const char *substring); 48 | static int SubstituteFile(const char *substs, const char *filename); 49 | static int QualifyPath(const char *path); 50 | static const char *GetVersionFromFile(const char *filename, const char *match, int numdots); 51 | static DWORD WINAPI ReadFromPipe(LPVOID args); 52 | 53 | /* globals */ 54 | 55 | #define CHUNK 25 56 | #define STATICBUFFERSIZE 1000 57 | typedef struct { 58 | HANDLE pipe; 59 | char buffer[STATICBUFFERSIZE]; 60 | } pipeinfo; 61 | 62 | pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; 63 | pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; 64 | 65 | /* 66 | * exitcodes: 0 == no, 1 == yes, 2 == error 67 | */ 68 | 69 | int 70 | main( 71 | int argc, 72 | char *argv[]) 73 | { 74 | char msg[300]; 75 | DWORD dwWritten; 76 | int chars; 77 | 78 | /* 79 | * Make sure children (cl.exe and link.exe) are kept quiet. 80 | */ 81 | 82 | SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); 83 | 84 | /* 85 | * Make sure the compiler and linker aren't effected by the outside world. 86 | */ 87 | 88 | SetEnvironmentVariable("CL", ""); 89 | SetEnvironmentVariable("LINK", ""); 90 | 91 | if (argc > 1 && *argv[1] == '-') { 92 | switch (*(argv[1]+1)) { 93 | case 'c': 94 | if (argc != 3) { 95 | chars = snprintf(msg, sizeof(msg) - 1, 96 | "usage: %s -c \n" 97 | "Tests for whether cl.exe supports an option\n" 98 | "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); 99 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, 100 | &dwWritten, NULL); 101 | return 2; 102 | } 103 | return CheckForCompilerFeature(argv[2]); 104 | case 'l': 105 | if (argc != 3) { 106 | chars = snprintf(msg, sizeof(msg) - 1, 107 | "usage: %s -l \n" 108 | "Tests for whether link.exe supports an option\n" 109 | "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); 110 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, 111 | &dwWritten, NULL); 112 | return 2; 113 | } 114 | return CheckForLinkerFeature(argv[2]); 115 | case 'f': 116 | if (argc == 2) { 117 | chars = snprintf(msg, sizeof(msg) - 1, 118 | "usage: %s -f \n" 119 | "Find a substring within another\n" 120 | "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); 121 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, 122 | &dwWritten, NULL); 123 | return 2; 124 | } else if (argc == 3) { 125 | /* 126 | * If the string is blank, there is no match. 127 | */ 128 | 129 | return 0; 130 | } else { 131 | return IsIn(argv[2], argv[3]); 132 | } 133 | case 's': 134 | if (argc == 2) { 135 | chars = snprintf(msg, sizeof(msg) - 1, 136 | "usage: %s -s \n" 137 | "Perform a set of string map type substutitions on a file\n" 138 | "exitcodes: 0\n", 139 | argv[0]); 140 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, 141 | &dwWritten, NULL); 142 | return 2; 143 | } 144 | return SubstituteFile(argv[2], argv[3]); 145 | case 'V': 146 | if (argc != 4) { 147 | chars = snprintf(msg, sizeof(msg) - 1, 148 | "usage: %s -V filename matchstring\n" 149 | "Extract a version from a file:\n" 150 | "eg: pkgIndex.tcl \"package ifneeded http\"", 151 | argv[0]); 152 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, 153 | &dwWritten, NULL); 154 | return 0; 155 | } 156 | printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0')); 157 | return 0; 158 | case 'Q': 159 | if (argc != 3) { 160 | chars = snprintf(msg, sizeof(msg) - 1, 161 | "usage: %s -Q path\n" 162 | "Emit the fully qualified path\n" 163 | "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); 164 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, 165 | &dwWritten, NULL); 166 | return 2; 167 | } 168 | return QualifyPath(argv[2]); 169 | } 170 | } 171 | chars = snprintf(msg, sizeof(msg) - 1, 172 | "usage: %s -c|-f|-l|-Q|-s|-V ...\n" 173 | "This is a little helper app to equalize shell differences between WinNT and\n" 174 | "Win9x and get nmake.exe to accomplish its job.\n", 175 | argv[0]); 176 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); 177 | return 2; 178 | } 179 | 180 | static int 181 | CheckForCompilerFeature( 182 | const char *option) 183 | { 184 | STARTUPINFO si; 185 | PROCESS_INFORMATION pi; 186 | SECURITY_ATTRIBUTES sa; 187 | DWORD threadID; 188 | char msg[300]; 189 | BOOL ok; 190 | HANDLE hProcess, h, pipeThreads[2]; 191 | char cmdline[100]; 192 | 193 | hProcess = GetCurrentProcess(); 194 | 195 | ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); 196 | ZeroMemory(&si, sizeof(STARTUPINFO)); 197 | si.cb = sizeof(STARTUPINFO); 198 | si.dwFlags = STARTF_USESTDHANDLES; 199 | si.hStdInput = INVALID_HANDLE_VALUE; 200 | 201 | ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); 202 | sa.nLength = sizeof(SECURITY_ATTRIBUTES); 203 | sa.lpSecurityDescriptor = NULL; 204 | sa.bInheritHandle = FALSE; 205 | 206 | /* 207 | * Create a non-inheritible pipe. 208 | */ 209 | 210 | CreatePipe(&Out.pipe, &h, &sa, 0); 211 | 212 | /* 213 | * Dupe the write side, make it inheritible, and close the original. 214 | */ 215 | 216 | DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, 217 | DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); 218 | 219 | /* 220 | * Same as above, but for the error side. 221 | */ 222 | 223 | CreatePipe(&Err.pipe, &h, &sa, 0); 224 | DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, 225 | DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); 226 | 227 | /* 228 | * Base command line. 229 | */ 230 | 231 | lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch "); 232 | 233 | /* 234 | * Append our option for testing 235 | */ 236 | 237 | lstrcat(cmdline, option); 238 | 239 | /* 240 | * Filename to compile, which exists, but is nothing and empty. 241 | */ 242 | 243 | lstrcat(cmdline, " .\\nul"); 244 | 245 | ok = CreateProcess( 246 | NULL, /* Module name. */ 247 | cmdline, /* Command line. */ 248 | NULL, /* Process handle not inheritable. */ 249 | NULL, /* Thread handle not inheritable. */ 250 | TRUE, /* yes, inherit handles. */ 251 | DETACHED_PROCESS, /* No console for you. */ 252 | NULL, /* Use parent's environment block. */ 253 | NULL, /* Use parent's starting directory. */ 254 | &si, /* Pointer to STARTUPINFO structure. */ 255 | &pi); /* Pointer to PROCESS_INFORMATION structure. */ 256 | 257 | if (!ok) { 258 | DWORD err = GetLastError(); 259 | int chars = snprintf(msg, sizeof(msg) - 1, 260 | "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); 261 | 262 | FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| 263 | FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], 264 | (300-chars), 0); 265 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); 266 | return 2; 267 | } 268 | 269 | /* 270 | * Close our references to the write handles that have now been inherited. 271 | */ 272 | 273 | CloseHandle(si.hStdOutput); 274 | CloseHandle(si.hStdError); 275 | 276 | WaitForInputIdle(pi.hProcess, 5000); 277 | CloseHandle(pi.hThread); 278 | 279 | /* 280 | * Start the pipe reader threads. 281 | */ 282 | 283 | pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); 284 | pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); 285 | 286 | /* 287 | * Block waiting for the process to end. 288 | */ 289 | 290 | WaitForSingleObject(pi.hProcess, INFINITE); 291 | CloseHandle(pi.hProcess); 292 | 293 | /* 294 | * Wait for our pipe to get done reading, should it be a little slow. 295 | */ 296 | 297 | WaitForMultipleObjects(2, pipeThreads, TRUE, 500); 298 | CloseHandle(pipeThreads[0]); 299 | CloseHandle(pipeThreads[1]); 300 | 301 | /* 302 | * Look for the commandline warning code in both streams. 303 | * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002. 304 | */ 305 | 306 | return !(strstr(Out.buffer, "D4002") != NULL 307 | || strstr(Err.buffer, "D4002") != NULL 308 | || strstr(Out.buffer, "D9002") != NULL 309 | || strstr(Err.buffer, "D9002") != NULL 310 | || strstr(Out.buffer, "D2021") != NULL 311 | || strstr(Err.buffer, "D2021") != NULL); 312 | } 313 | 314 | static int 315 | CheckForLinkerFeature( 316 | const char *option) 317 | { 318 | STARTUPINFO si; 319 | PROCESS_INFORMATION pi; 320 | SECURITY_ATTRIBUTES sa; 321 | DWORD threadID; 322 | char msg[300]; 323 | BOOL ok; 324 | HANDLE hProcess, h, pipeThreads[2]; 325 | char cmdline[100]; 326 | 327 | hProcess = GetCurrentProcess(); 328 | 329 | ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); 330 | ZeroMemory(&si, sizeof(STARTUPINFO)); 331 | si.cb = sizeof(STARTUPINFO); 332 | si.dwFlags = STARTF_USESTDHANDLES; 333 | si.hStdInput = INVALID_HANDLE_VALUE; 334 | 335 | ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); 336 | sa.nLength = sizeof(SECURITY_ATTRIBUTES); 337 | sa.lpSecurityDescriptor = NULL; 338 | sa.bInheritHandle = TRUE; 339 | 340 | /* 341 | * Create a non-inheritible pipe. 342 | */ 343 | 344 | CreatePipe(&Out.pipe, &h, &sa, 0); 345 | 346 | /* 347 | * Dupe the write side, make it inheritible, and close the original. 348 | */ 349 | 350 | DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE, 351 | DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); 352 | 353 | /* 354 | * Same as above, but for the error side. 355 | */ 356 | 357 | CreatePipe(&Err.pipe, &h, &sa, 0); 358 | DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE, 359 | DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); 360 | 361 | /* 362 | * Base command line. 363 | */ 364 | 365 | lstrcpy(cmdline, "link.exe -nologo "); 366 | 367 | /* 368 | * Append our option for testing. 369 | */ 370 | 371 | lstrcat(cmdline, option); 372 | 373 | ok = CreateProcess( 374 | NULL, /* Module name. */ 375 | cmdline, /* Command line. */ 376 | NULL, /* Process handle not inheritable. */ 377 | NULL, /* Thread handle not inheritable. */ 378 | TRUE, /* yes, inherit handles. */ 379 | DETACHED_PROCESS, /* No console for you. */ 380 | NULL, /* Use parent's environment block. */ 381 | NULL, /* Use parent's starting directory. */ 382 | &si, /* Pointer to STARTUPINFO structure. */ 383 | &pi); /* Pointer to PROCESS_INFORMATION structure. */ 384 | 385 | if (!ok) { 386 | DWORD err = GetLastError(); 387 | int chars = snprintf(msg, sizeof(msg) - 1, 388 | "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); 389 | 390 | FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| 391 | FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], 392 | (300-chars), 0); 393 | WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); 394 | return 2; 395 | } 396 | 397 | /* 398 | * Close our references to the write handles that have now been inherited. 399 | */ 400 | 401 | CloseHandle(si.hStdOutput); 402 | CloseHandle(si.hStdError); 403 | 404 | WaitForInputIdle(pi.hProcess, 5000); 405 | CloseHandle(pi.hThread); 406 | 407 | /* 408 | * Start the pipe reader threads. 409 | */ 410 | 411 | pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); 412 | pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); 413 | 414 | /* 415 | * Block waiting for the process to end. 416 | */ 417 | 418 | WaitForSingleObject(pi.hProcess, INFINITE); 419 | CloseHandle(pi.hProcess); 420 | 421 | /* 422 | * Wait for our pipe to get done reading, should it be a little slow. 423 | */ 424 | 425 | WaitForMultipleObjects(2, pipeThreads, TRUE, 500); 426 | CloseHandle(pipeThreads[0]); 427 | CloseHandle(pipeThreads[1]); 428 | 429 | /* 430 | * Look for the commandline warning code in the stderr stream. 431 | */ 432 | 433 | return !(strstr(Out.buffer, "LNK1117") != NULL || 434 | strstr(Err.buffer, "LNK1117") != NULL || 435 | strstr(Out.buffer, "LNK4044") != NULL || 436 | strstr(Err.buffer, "LNK4044") != NULL); 437 | } 438 | 439 | static DWORD WINAPI 440 | ReadFromPipe( 441 | LPVOID args) 442 | { 443 | pipeinfo *pi = (pipeinfo *) args; 444 | char *lastBuf = pi->buffer; 445 | DWORD dwRead; 446 | BOOL ok; 447 | 448 | again: 449 | if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) { 450 | CloseHandle(pi->pipe); 451 | return (DWORD)-1; 452 | } 453 | ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L); 454 | if (!ok || dwRead == 0) { 455 | CloseHandle(pi->pipe); 456 | return 0; 457 | } 458 | lastBuf += dwRead; 459 | goto again; 460 | 461 | return 0; /* makes the compiler happy */ 462 | } 463 | 464 | static int 465 | IsIn( 466 | const char *string, 467 | const char *substring) 468 | { 469 | return (strstr(string, substring) != NULL); 470 | } 471 | 472 | /* 473 | * GetVersionFromFile -- 474 | * Looks for a match string in a file and then returns the version 475 | * following the match where a version is anything acceptable to 476 | * package provide or package ifneeded. 477 | */ 478 | 479 | static const char * 480 | GetVersionFromFile( 481 | const char *filename, 482 | const char *match, 483 | int numdots) 484 | { 485 | size_t cbBuffer = 100; 486 | static char szBuffer[100]; 487 | char *szResult = NULL; 488 | FILE *fp = fopen(filename, "rt"); 489 | 490 | if (fp != NULL) { 491 | /* 492 | * Read data until we see our match string. 493 | */ 494 | 495 | while (fgets(szBuffer, cbBuffer, fp) != NULL) { 496 | LPSTR p, q; 497 | 498 | p = strstr(szBuffer, match); 499 | if (p != NULL) { 500 | /* 501 | * Skip to first digit after the match. 502 | */ 503 | 504 | p += strlen(match); 505 | while (*p && !isdigit(*p)) { 506 | ++p; 507 | } 508 | 509 | /* 510 | * Find ending whitespace. 511 | */ 512 | 513 | q = p; 514 | while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q) 515 | && (!strchr("ab", q[-1])) || --numdots))) { 516 | ++q; 517 | } 518 | 519 | memcpy(szBuffer, p, q - p); 520 | szBuffer[q-p] = 0; 521 | szResult = szBuffer; 522 | break; 523 | } 524 | } 525 | fclose(fp); 526 | } 527 | return szResult; 528 | } 529 | 530 | /* 531 | * List helpers for the SubstituteFile function 532 | */ 533 | 534 | typedef struct list_item_t { 535 | struct list_item_t *nextPtr; 536 | char * key; 537 | char * value; 538 | } list_item_t; 539 | 540 | /* insert a list item into the list (list may be null) */ 541 | static list_item_t * 542 | list_insert(list_item_t **listPtrPtr, const char *key, const char *value) 543 | { 544 | list_item_t *itemPtr = malloc(sizeof(list_item_t)); 545 | if (itemPtr) { 546 | itemPtr->key = strdup(key); 547 | itemPtr->value = strdup(value); 548 | itemPtr->nextPtr = NULL; 549 | 550 | while(*listPtrPtr) { 551 | listPtrPtr = &(*listPtrPtr)->nextPtr; 552 | } 553 | *listPtrPtr = itemPtr; 554 | } 555 | return itemPtr; 556 | } 557 | 558 | static void 559 | list_free(list_item_t **listPtrPtr) 560 | { 561 | list_item_t *tmpPtr, *listPtr = *listPtrPtr; 562 | while (listPtr) { 563 | tmpPtr = listPtr; 564 | listPtr = listPtr->nextPtr; 565 | free(tmpPtr->key); 566 | free(tmpPtr->value); 567 | free(tmpPtr); 568 | } 569 | } 570 | 571 | /* 572 | * SubstituteFile -- 573 | * As windows doesn't provide anything useful like sed and it's unreliable 574 | * to use the tclsh you are building against (consider x-platform builds - 575 | * eg compiling AMD64 target from IX86) we provide a simple substitution 576 | * option here to handle autoconf style substitutions. 577 | * The substitution file is whitespace and line delimited. The file should 578 | * consist of lines matching the regular expression: 579 | * \s*\S+\s+\S*$ 580 | * 581 | * Usage is something like: 582 | * nmakehlp -S << $** > $@ 583 | * @PACKAGE_NAME@ $(PACKAGE_NAME) 584 | * @PACKAGE_VERSION@ $(PACKAGE_VERSION) 585 | * << 586 | */ 587 | 588 | static int 589 | SubstituteFile( 590 | const char *substitutions, 591 | const char *filename) 592 | { 593 | size_t cbBuffer = 1024; 594 | static char szBuffer[1024], szCopy[1024]; 595 | char *szResult = NULL; 596 | list_item_t *substPtr = NULL; 597 | FILE *fp, *sp; 598 | 599 | fp = fopen(filename, "rt"); 600 | if (fp != NULL) { 601 | 602 | /* 603 | * Build a list of substutitions from the first filename 604 | */ 605 | 606 | sp = fopen(substitutions, "rt"); 607 | if (sp != NULL) { 608 | while (fgets(szBuffer, cbBuffer, sp) != NULL) { 609 | char *ks, *ke, *vs, *ve; 610 | ks = szBuffer; 611 | while (ks && *ks && isspace(*ks)) ++ks; 612 | ke = ks; 613 | while (ke && *ke && !isspace(*ke)) ++ke; 614 | vs = ke; 615 | while (vs && *vs && isspace(*vs)) ++vs; 616 | ve = vs; 617 | while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; 618 | *ke = 0, *ve = 0; 619 | list_insert(&substPtr, ks, vs); 620 | } 621 | fclose(sp); 622 | } 623 | 624 | /* debug: dump the list */ 625 | #ifdef _DEBUG 626 | { 627 | int n = 0; 628 | list_item_t *p = NULL; 629 | for (p = substPtr; p != NULL; p = p->nextPtr, ++n) { 630 | fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value); 631 | } 632 | } 633 | #endif 634 | 635 | /* 636 | * Run the substitutions over each line of the input 637 | */ 638 | 639 | while (fgets(szBuffer, cbBuffer, fp) != NULL) { 640 | list_item_t *p = NULL; 641 | for (p = substPtr; p != NULL; p = p->nextPtr) { 642 | char *m = strstr(szBuffer, p->key); 643 | if (m) { 644 | char *cp, *op, *sp; 645 | cp = szCopy; 646 | op = szBuffer; 647 | while (op != m) *cp++ = *op++; 648 | sp = p->value; 649 | while (sp && *sp) *cp++ = *sp++; 650 | op += strlen(p->key); 651 | while (*op) *cp++ = *op++; 652 | *cp = 0; 653 | memcpy(szBuffer, szCopy, sizeof(szCopy)); 654 | } 655 | } 656 | printf(szBuffer); 657 | } 658 | 659 | list_free(&substPtr); 660 | } 661 | fclose(fp); 662 | return 0; 663 | } 664 | 665 | /* 666 | * QualifyPath -- 667 | * 668 | * This composes the current working directory with a provided path 669 | * and returns the fully qualified and normalized path. 670 | * Mostly needed to setup paths for testing. 671 | */ 672 | 673 | static int 674 | QualifyPath( 675 | const char *szPath) 676 | { 677 | char szCwd[MAX_PATH + 1]; 678 | char szTmp[MAX_PATH + 1]; 679 | char *p; 680 | GetCurrentDirectory(MAX_PATH, szCwd); 681 | while ((p = strchr(szPath, '/')) && *p) 682 | *p = '\\'; 683 | PathCombine(szTmp, szCwd, szPath); 684 | PathCanonicalize(szCwd, szTmp); 685 | printf("%s\n", szCwd); 686 | return 0; 687 | } 688 | 689 | /* 690 | * Local variables: 691 | * mode: c 692 | * c-basic-offset: 4 693 | * fill-column: 78 694 | * indent-tabs-mode: t 695 | * tab-width: 8 696 | * End: 697 | */ 698 | -------------------------------------------------------------------------------- /win/rules.vc: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | # rules.vc -- 3 | # 4 | # Microsoft Visual C++ makefile include for decoding the commandline 5 | # macros. This file does not need editing to build Tcl. 6 | # 7 | # This version is modified from the Tcl source version to support 8 | # building extensions using nmake. 9 | # 10 | # See the file "license.terms" for information on usage and redistribution 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 | # 13 | # Copyright (c) 2001-2003 David Gravereaux. 14 | # Copyright (c) 2003-2008 Patrick Thoyts 15 | #------------------------------------------------------------------------------ 16 | 17 | !ifndef _RULES_VC 18 | _RULES_VC = 1 19 | 20 | cc32 = $(CC) # built-in default. 21 | link32 = link 22 | lib32 = lib 23 | rc32 = $(RC) # built-in default. 24 | 25 | !ifndef INSTALLDIR 26 | ### Assume the normal default. 27 | _INSTALLDIR = C:\Program Files\Tcl 28 | !else 29 | ### Fix the path separators. 30 | _INSTALLDIR = $(INSTALLDIR:/=\) 31 | !endif 32 | 33 | #---------------------------------------------------------- 34 | # Set the proper copy method to avoid overwrite questions 35 | # to the user when copying files and selecting the right 36 | # "delete all" method. 37 | #---------------------------------------------------------- 38 | 39 | !if "$(OS)" == "Windows_NT" 40 | RMDIR = rmdir /S /Q 41 | ERRNULL = 2>NUL 42 | !if ![ver | find "4.0" > nul] 43 | CPY = echo y | xcopy /i >NUL 44 | COPY = copy >NUL 45 | !else 46 | CPY = xcopy /i /y >NUL 47 | COPY = copy /y >NUL 48 | !endif 49 | !else # "$(OS)" != "Windows_NT" 50 | CPY = xcopy /i >_JUNK.OUT # On Win98 NUL does not work here. 51 | COPY = copy >_JUNK.OUT # On Win98 NUL does not work here. 52 | RMDIR = deltree /Y 53 | NULL = \NUL # Used in testing directory existence 54 | ERRNULL = >NUL # Win9x shell cannot redirect stderr 55 | !endif 56 | MKDIR = mkdir 57 | 58 | #------------------------------------------------------------------------------ 59 | # Determine the host and target architectures and compiler version. 60 | #------------------------------------------------------------------------------ 61 | 62 | _HASH=^# 63 | _VC_MANIFEST_EMBED_EXE= 64 | _VC_MANIFEST_EMBED_DLL= 65 | VCVER=0 66 | !if ![echo VCVERSION=_MSC_VER > vercl.x] \ 67 | && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \ 68 | && ![echo ARCH=IX86 >> vercl.x] \ 69 | && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \ 70 | && ![echo ARCH=AMD64 >> vercl.x] \ 71 | && ![echo $(_HASH)endif >> vercl.x] \ 72 | && ![cl -nologo -TC -P vercl.x $(ERRNULL)] 73 | !include vercl.i 74 | !if ![echo VCVER= ^\> vercl.vc] \ 75 | && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc] 76 | !include vercl.vc 77 | !endif 78 | !endif 79 | !if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc] 80 | !endif 81 | 82 | !if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86] 83 | NATIVE_ARCH=IX86 84 | !else 85 | NATIVE_ARCH=AMD64 86 | !endif 87 | 88 | # Since MSVC8 we must deal with manifest resources. 89 | !if $(VCVERSION) >= 1400 90 | _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 91 | _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 92 | !endif 93 | 94 | !ifndef MACHINE 95 | MACHINE=$(ARCH) 96 | !endif 97 | 98 | !ifndef CFG_ENCODING 99 | CFG_ENCODING = \"cp1252\" 100 | !endif 101 | 102 | !message =============================================================================== 103 | 104 | #---------------------------------------------------------- 105 | # build the helper app we need to overcome nmake's limiting 106 | # environment. 107 | #---------------------------------------------------------- 108 | 109 | !if !exist(nmakehlp.exe) 110 | !if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul] 111 | !endif 112 | !endif 113 | 114 | #---------------------------------------------------------- 115 | # Test for compiler features 116 | #---------------------------------------------------------- 117 | 118 | ### test for optimizations 119 | !if [nmakehlp -c -Ot] 120 | !message *** Compiler has 'Optimizations' 121 | OPTIMIZING = 1 122 | !else 123 | !message *** Compiler does not have 'Optimizations' 124 | OPTIMIZING = 0 125 | !endif 126 | 127 | OPTIMIZATIONS = 128 | 129 | !if [nmakehlp -c -Ot] 130 | OPTIMIZATIONS = $(OPTIMIZATIONS) -Ot 131 | !endif 132 | 133 | !if [nmakehlp -c -Oi] 134 | OPTIMIZATIONS = $(OPTIMIZATIONS) -Oi 135 | !endif 136 | 137 | !if [nmakehlp -c -Op] 138 | OPTIMIZATIONS = $(OPTIMIZATIONS) -Op 139 | !endif 140 | 141 | !if [nmakehlp -c -fp:strict] 142 | OPTIMIZATIONS = $(OPTIMIZATIONS) -fp:strict 143 | !endif 144 | 145 | !if [nmakehlp -c -Gs] 146 | OPTIMIZATIONS = $(OPTIMIZATIONS) -Gs 147 | !endif 148 | 149 | !if [nmakehlp -c -GS] 150 | OPTIMIZATIONS = $(OPTIMIZATIONS) -GS 151 | !endif 152 | 153 | !if [nmakehlp -c -GL] 154 | OPTIMIZATIONS = $(OPTIMIZATIONS) -GL 155 | !endif 156 | 157 | DEBUGFLAGS = 158 | 159 | !if [nmakehlp -c -RTC1] 160 | DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 161 | !elseif [nmakehlp -c -GZ] 162 | DEBUGFLAGS = $(DEBUGFLAGS) -GZ 163 | !endif 164 | 165 | COMPILERFLAGS =-W3 166 | 167 | # In v13 -GL and -YX are incompatible. 168 | !if [nmakehlp -c -YX] 169 | !if ![nmakehlp -c -GL] 170 | OPTIMIZATIONS = $(OPTIMIZATIONS) -YX 171 | !endif 172 | !endif 173 | 174 | !if "$(MACHINE)" == "IX86" 175 | ### test for pentium errata 176 | !if [nmakehlp -c -QI0f] 177 | !message *** Compiler has 'Pentium 0x0f fix' 178 | COMPILERFLAGS = $(COMPILERFLAGS) -QI0f 179 | !else 180 | !message *** Compiler does not have 'Pentium 0x0f fix' 181 | !endif 182 | !endif 183 | 184 | !if "$(MACHINE)" == "IA64" 185 | ### test for Itanium errata 186 | !if [nmakehlp -c -QIA64_Bx] 187 | !message *** Compiler has 'B-stepping errata workarounds' 188 | COMPILERFLAGS = $(COMPILERFLAGS) -QIA64_Bx 189 | !else 190 | !message *** Compiler does not have 'B-stepping errata workarounds' 191 | !endif 192 | !endif 193 | 194 | !if "$(MACHINE)" == "IX86" 195 | ### test for -align:4096, when align:512 will do. 196 | !if [nmakehlp -l -opt:nowin98] 197 | !message *** Linker has 'Win98 alignment problem' 198 | ALIGN98_HACK = 1 199 | !else 200 | !message *** Linker does not have 'Win98 alignment problem' 201 | ALIGN98_HACK = 0 202 | !endif 203 | !else 204 | ALIGN98_HACK = 0 205 | !endif 206 | 207 | LINKERFLAGS = 208 | 209 | !if [nmakehlp -l -ltcg] 210 | LINKERFLAGS =-ltcg 211 | !endif 212 | 213 | #---------------------------------------------------------- 214 | # Decode the options requested. 215 | #---------------------------------------------------------- 216 | 217 | !if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] 218 | STATIC_BUILD = 0 219 | TCL_THREADS = 1 220 | DEBUG = 0 221 | SYMBOLS = 0 222 | PROFILE = 0 223 | PGO = 0 224 | MSVCRT = 0 225 | LOIMPACT = 0 226 | UNCHECKED = 0 227 | !else 228 | !if [nmakehlp -f $(OPTS) "static"] 229 | !message *** Doing static 230 | STATIC_BUILD = 1 231 | !else 232 | STATIC_BUILD = 0 233 | !endif 234 | !if [nmakehlp -f $(OPTS) "msvcrt"] 235 | !message *** Doing msvcrt 236 | MSVCRT = 1 237 | !else 238 | MSVCRT = 0 239 | !endif 240 | !if [nmakehlp -f $(OPTS) "nothreads"] 241 | !message *** Compile explicitly for non-threaded tcl 242 | TCL_THREADS = 0 243 | !else 244 | TCL_THREADS = 1 245 | !endif 246 | !if [nmakehlp -f $(OPTS) "symbols"] 247 | !message *** Doing symbols 248 | DEBUG = 1 249 | !else 250 | DEBUG = 0 251 | !endif 252 | !if [nmakehlp -f $(OPTS) "pdbs"] 253 | !message *** Doing pdbs 254 | SYMBOLS = 1 255 | !else 256 | SYMBOLS = 0 257 | !endif 258 | !if [nmakehlp -f $(OPTS) "profile"] 259 | !message *** Doing profile 260 | PROFILE = 1 261 | !else 262 | PROFILE = 0 263 | !endif 264 | !if [nmakehlp -f $(OPTS) "pgi"] 265 | !message *** Doing profile guided optimization instrumentation 266 | PGO = 1 267 | !elseif [nmakehlp -f $(OPTS) "pgo"] 268 | !message *** Doing profile guided optimization 269 | PGO = 2 270 | !else 271 | PGO = 0 272 | !endif 273 | !if [nmakehlp -f $(OPTS) "loimpact"] 274 | !message *** Doing loimpact 275 | LOIMPACT = 1 276 | !else 277 | LOIMPACT = 0 278 | !endif 279 | !if [nmakehlp -f $(OPTS) "unchecked"] 280 | !message *** Doing unchecked 281 | UNCHECKED = 1 282 | !else 283 | UNCHECKED = 0 284 | !endif 285 | !endif 286 | 287 | 288 | !if !$(STATIC_BUILD) 289 | # Make sure we don't build overly fat DLLs. 290 | MSVCRT = 1 291 | # We shouldn't statically put the extensions inside the shell when dynamic. 292 | TCL_USE_STATIC_PACKAGES = 0 293 | !endif 294 | 295 | 296 | #---------------------------------------------------------- 297 | # Figure-out how to name our intermediate and output directories. 298 | # We wouldn't want different builds to use the same .obj files 299 | # by accident. 300 | #---------------------------------------------------------- 301 | 302 | #---------------------------------------- 303 | # Naming convention: 304 | # t = full thread support. 305 | # s = static library (as opposed to an 306 | # import library) 307 | # g = linked to the debug enabled C 308 | # run-time. 309 | # x = special static build when it 310 | # links to the dynamic C run-time. 311 | #---------------------------------------- 312 | SUFX = sgx 313 | 314 | !if $(DEBUG) 315 | BUILDDIRTOP = Debug 316 | !else 317 | BUILDDIRTOP = Release 318 | !endif 319 | 320 | !if "$(MACHINE)" != "IX86" 321 | BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE) 322 | !endif 323 | !if $(VCVER) > 6 324 | BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER) 325 | !endif 326 | 327 | !if !$(DEBUG) || $(DEBUG) && $(UNCHECKED) 328 | SUFX = $(SUFX:g=) 329 | !endif 330 | 331 | TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX 332 | 333 | !if !$(STATIC_BUILD) 334 | TMP_DIRFULL = $(TMP_DIRFULL:Static=) 335 | SUFX = $(SUFX:s=) 336 | EXT = dll 337 | !if $(MSVCRT) 338 | TMP_DIRFULL = $(TMP_DIRFULL:X=) 339 | SUFX = $(SUFX:x=) 340 | !endif 341 | !else 342 | TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) 343 | EXT = lib 344 | !if !$(MSVCRT) 345 | TMP_DIRFULL = $(TMP_DIRFULL:X=) 346 | SUFX = $(SUFX:x=) 347 | !endif 348 | !endif 349 | 350 | !if !$(TCL_THREADS) 351 | TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) 352 | SUFX = $(SUFX:t=) 353 | !endif 354 | 355 | !ifndef TMP_DIR 356 | TMP_DIR = $(TMP_DIRFULL) 357 | !ifndef OUT_DIR 358 | OUT_DIR = .\$(BUILDDIRTOP) 359 | !endif 360 | !else 361 | !ifndef OUT_DIR 362 | OUT_DIR = $(TMP_DIR) 363 | !endif 364 | !endif 365 | 366 | 367 | #---------------------------------------------------------- 368 | # Decode the statistics requested. 369 | #---------------------------------------------------------- 370 | 371 | !if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"] 372 | TCL_MEM_DEBUG = 0 373 | TCL_COMPILE_DEBUG = 0 374 | !else 375 | !if [nmakehlp -f $(STATS) "memdbg"] 376 | !message *** Doing memdbg 377 | TCL_MEM_DEBUG = 1 378 | !else 379 | TCL_MEM_DEBUG = 0 380 | !endif 381 | !if [nmakehlp -f $(STATS) "compdbg"] 382 | !message *** Doing compdbg 383 | TCL_COMPILE_DEBUG = 1 384 | !else 385 | TCL_COMPILE_DEBUG = 0 386 | !endif 387 | !endif 388 | 389 | 390 | #---------------------------------------------------------- 391 | # Decode the checks requested. 392 | #---------------------------------------------------------- 393 | 394 | !if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"] 395 | TCL_NO_DEPRECATED = 0 396 | WARNINGS = -W3 397 | !else 398 | !if [nmakehlp -f $(CHECKS) "nodep"] 399 | !message *** Doing nodep check 400 | TCL_NO_DEPRECATED = 1 401 | !else 402 | TCL_NO_DEPRECATED = 0 403 | !endif 404 | !if [nmakehlp -f $(CHECKS) "fullwarn"] 405 | !message *** Doing full warnings check 406 | WARNINGS = -W4 407 | !if [nmakehlp -l -warn:3] 408 | LINKERFLAGS = $(LINKERFLAGS) -warn:3 409 | !endif 410 | !else 411 | WARNINGS = -W3 412 | !endif 413 | !if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64] 414 | !message *** Doing 64bit portability warnings 415 | WARNINGS = $(WARNINGS) -Wp64 416 | !endif 417 | !endif 418 | 419 | !if $(PGO) > 1 420 | !if [nmakehlp -l -ltcg:pgoptimize] 421 | LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize 422 | !else 423 | MSG=^ 424 | This compiler does not support profile guided optimization. 425 | !error $(MSG) 426 | !endif 427 | !elseif $(PGO) > 0 428 | !if [nmakehlp -l -ltcg:pginstrument] 429 | LINKERFLAGS = $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument 430 | !else 431 | MSG=^ 432 | This compiler does not support profile guided optimization. 433 | !error $(MSG) 434 | !endif 435 | !endif 436 | 437 | #---------------------------------------------------------- 438 | # Set our defines now armed with our options. 439 | #---------------------------------------------------------- 440 | 441 | OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS 442 | 443 | !if $(TCL_MEM_DEBUG) 444 | OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG 445 | !endif 446 | !if $(TCL_COMPILE_DEBUG) 447 | OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS 448 | !endif 449 | !if $(TCL_THREADS) 450 | OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 451 | !endif 452 | !if $(STATIC_BUILD) 453 | OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD 454 | !endif 455 | !if $(TCL_NO_DEPRECATED) 456 | OPTDEFINES = $(OPTDEFINES) -DTCL_NO_DEPRECATED 457 | !endif 458 | 459 | !if !$(DEBUG) 460 | OPTDEFINES = $(OPTDEFINES) -DNDEBUG 461 | !if $(OPTIMIZING) 462 | OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED 463 | !endif 464 | !endif 465 | !if $(PROFILE) 466 | OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED 467 | !endif 468 | !if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" 469 | OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT 470 | !endif 471 | 472 | 473 | #---------------------------------------------------------- 474 | # Get common info used when building extensions. 475 | #---------------------------------------------------------- 476 | 477 | !if "$(PROJECT)" != "tcl" 478 | 479 | # If INSTALLDIR set to tcl root dir then reset to the lib dir. 480 | !if exist("$(_INSTALLDIR)\include\tcl.h") 481 | _INSTALLDIR=$(_INSTALLDIR)\lib 482 | !endif 483 | 484 | !if !defined(TCLDIR) 485 | !if exist("$(_INSTALLDIR)\..\include\tcl.h") 486 | TCLINSTALL = 1 487 | _TCLDIR = $(_INSTALLDIR)\.. 488 | _TCL_H = $(_INSTALLDIR)\..\include\tcl.h 489 | TCLDIR = $(_INSTALLDIR)\.. 490 | !else 491 | MSG=^ 492 | Failed to find tcl.h. Set the TCLDIR macro. 493 | !error $(MSG) 494 | !endif 495 | !else 496 | _TCLDIR = $(TCLDIR:/=\) 497 | !if exist("$(_TCLDIR)\include\tcl.h") 498 | TCLINSTALL = 1 499 | _TCL_H = $(_TCLDIR)\include\tcl.h 500 | !elseif exist("$(_TCLDIR)\generic\tcl.h") 501 | TCLINSTALL = 0 502 | _TCL_H = $(_TCLDIR)\generic\tcl.h 503 | !else 504 | MSG =^ 505 | Failed to find tcl.h. The TCLDIR macro does not appear correct. 506 | !error $(MSG) 507 | !endif 508 | !endif 509 | !endif 510 | 511 | #-------------------------------------------------------------- 512 | # Extract various version numbers from tcl headers 513 | # The generated file is then included in the makefile. 514 | #-------------------------------------------------------------- 515 | 516 | !if [echo REM = This file is generated from rules.vc > versions.vc] 517 | !endif 518 | !if [echo TCL_MAJOR_VERSION = \>> versions.vc] \ 519 | && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc] 520 | !endif 521 | !if [echo TCL_MINOR_VERSION = \>> versions.vc] \ 522 | && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc] 523 | !endif 524 | !if [echo TCL_PATCH_LEVEL = \>> versions.vc] \ 525 | && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc] 526 | !endif 527 | 528 | # If building the tcl core then we need additional package versions 529 | !if "$(PROJECT)" == "tcl" 530 | !if [echo PKG_HTTP_VER = \>> versions.vc] \ 531 | && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc] 532 | !endif 533 | !if [echo PKG_TCLTEST_VER = \>> versions.vc] \ 534 | && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc] 535 | !endif 536 | !if [echo PKG_MSGCAT_VER = \>> versions.vc] \ 537 | && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc] 538 | !endif 539 | !if [echo PKG_PLATFORM_VER = \>> versions.vc] \ 540 | && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc] 541 | !endif 542 | !if [echo PKG_SHELL_VER = \>> versions.vc] \ 543 | && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] 544 | !endif 545 | !endif 546 | 547 | !include versions.vc 548 | 549 | #-------------------------------------------------------------- 550 | # Setup tcl version dependent stuff headers 551 | #-------------------------------------------------------------- 552 | 553 | !if "$(PROJECT)" != "tcl" 554 | 555 | TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) 556 | 557 | !if $(TCL_VERSION) < 81 558 | TCL_DOES_STUBS = 0 559 | !else 560 | TCL_DOES_STUBS = 1 561 | !endif 562 | 563 | !if $(TCLINSTALL) 564 | _TCLBINDIR = "$(_TCLDIR)\bin" 565 | TCLSH = "$(_TCLBINDIR)\tclsh$(TCL_VERSION)$(SUFX).exe" 566 | !if !exist($(TCLSH)) && $(TCL_THREADS) 567 | TCLSH = "$(_TCLBINDIR)\tclsh$(TCL_VERSION)t$(SUFX).exe" 568 | !endif 569 | TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" 570 | TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" 571 | TCL_LIBRARY = $(_TCLDIR)\lib 572 | COFFBASE = \must\have\tcl\sources\to\build\this\target 573 | TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target 574 | TCL_INCLUDES = -I"$(_TCLDIR)\include" 575 | !else 576 | _TCLBINDIR = $(_TCLDIR)\win\$(BUILDDIRTOP) 577 | TCLSH = "$(_TCLBINDIR)\tclsh$(TCL_VERSION)$(SUFX).exe" 578 | !if !exist($(TCLSH)) && $(TCL_THREADS) 579 | TCLSH = "$(_TCLBINDIR)\tclsh$(TCL_VERSION)t$(SUFX).exe" 580 | !endif 581 | TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" 582 | TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" 583 | TCL_LIBRARY = $(_TCLDIR)\library 584 | COFFBASE = "$(_TCLDIR)\win\coffbase.txt" 585 | TCLTOOLSDIR = $(_TCLDIR)\tools 586 | TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" 587 | !endif 588 | 589 | !endif 590 | 591 | #---------------------------------------------------------- 592 | # Optionally check for Tk info for building extensions. 593 | #---------------------------------------------------------- 594 | 595 | !ifdef PROJECT_REQUIRES_TK 596 | !if !defined(TKDIR) 597 | !if exist("$(_INSTALLDIR)\..\include\tk.h") 598 | TKINSTALL = 1 599 | _TKDIR = $(_INSTALLDIR)\.. 600 | _TK_H = $(_TKDIR)\include\tk.h 601 | TKDIR = $(_TKDIR) 602 | !elseif exist("$(_TCLDIR)\include\tk.h") 603 | TKINSTALL = 1 604 | _TKDIR = $(_TCLDIR) 605 | _TK_H = $(_TKDIR)\include\tk.h 606 | TKDIR = $(_TKDIR) 607 | !endif 608 | !else 609 | _TKDIR = $(TKDIR:/=\) 610 | !if exist("$(_TKDIR)\include\tk.h") 611 | TKINSTALL = 1 612 | _TK_H = $(_TKDIR)\include\tk.h 613 | !elseif exist("$(_TKDIR)\generic\tk.h") 614 | TKINSTALL = 0 615 | _TK_H = $(_TKDIR)\generic\tk.h 616 | !else 617 | MSG =^ 618 | Failed to find tk.h. The TKDIR macro does not appear correct. 619 | !error $(MSG) 620 | !endif 621 | !endif 622 | !endif 623 | 624 | #------------------------------------------------------------------------- 625 | # Extract Tk version numbers 626 | #------------------------------------------------------------------------- 627 | 628 | !if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk" 629 | !if [echo TK_MAJOR_VERSION = \>> versions.vc] \ 630 | && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc] 631 | !endif 632 | !if [echo TK_MINOR_VERSION = \>> versions.vc] \ 633 | && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc] 634 | !endif 635 | !if [echo TK_PATCH_LEVEL = \>> versions.vc] \ 636 | && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc] 637 | !endif 638 | 639 | !include versions.vc 640 | 641 | TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION) 642 | TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION) 643 | 644 | !if "$(PROJECT)" != "tk" 645 | !if $(TKINSTALL) 646 | _TKBINDIR = $(_TKDIR)\bin 647 | WISH = "$(_TKBINDIR)\wish$(TK_VERSION)$(SUFX).exe" 648 | !if !exist($(WISH)) && $(TCL_THREADS) 649 | WISH = "$(_TKBINDIR)\wish$(TK_VERSION)t$(SUFX).exe" 650 | !endif 651 | TKSTUBLIB = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib" 652 | TK_LIBRARY = $(_TKDIR)\lib 653 | TKIMPLIB = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib" 654 | TK_INCLUDES = -I"$(_TKDIR)\include" 655 | !else 656 | _TKBINDIR = $(_TKDIR)\win\$(BUILDDIRTOP) 657 | WISH = "$(_TKBINDIR)\wish$(TCL_VERSION)$(SUFX).exe" 658 | !if !exist($(WISH)) && $(TCL_THREADS) 659 | WISH = "$(_TKBINDIR)\wish$(TCL_VERSION)t$(SUFX).exe" 660 | !endif 661 | TKSTUBLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib" 662 | TKIMPLIB = "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib" 663 | TK_LIBRARY = $(_TKDIR)\library 664 | TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib" 665 | !endif 666 | !endif 667 | 668 | !endif 669 | 670 | #---------------------------------------------------------- 671 | # Setup the fully qualified OUT_DIR path as OUT_DIR_PATH 672 | #---------------------------------------------------------- 673 | !if [echo OUT_DIR_PATH = \>> versions.vc] \ 674 | && [nmakehlp -Q "$(OUT_DIR)" >> versions.vc] 675 | !endif 676 | !include versions.vc 677 | 678 | #---------------------------------------------------------- 679 | # Display stats being used. 680 | #---------------------------------------------------------- 681 | 682 | !message *** Intermediate directory will be '$(TMP_DIR)' 683 | !message *** Output directory will be '$(OUT_DIR)' 684 | !message *** Suffix for binaries will be '$(SUFX)' 685 | !message *** Optional defines are '$(OPTDEFINES)' 686 | !message *** Compiler version $(VCVER). Target machine is $(MACHINE) 687 | !message *** Host architecture is $(NATIVE_ARCH) 688 | !message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)' 689 | !message *** Link options '$(LINKERFLAGS)' 690 | 691 | !endif 692 | -------------------------------------------------------------------------------- /library/tdbcsqlite3.tcl: -------------------------------------------------------------------------------- 1 | # tdbcsqlite3.tcl -- 2 | # 3 | # SQLite3 database driver for TDBC 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: tdbcodbc.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $ 10 | # 11 | #------------------------------------------------------------------------------ 12 | 13 | package require tdbc 14 | package require sqlite3 15 | 16 | package provide tdbc::sqlite3 1.0.0 17 | 18 | namespace eval tdbc::sqlite3 { 19 | namespace export connection 20 | } 21 | 22 | #------------------------------------------------------------------------------ 23 | # 24 | # tdbc::sqlite3::connection -- 25 | # 26 | # Class representing a SQLite3 database connection 27 | # 28 | #------------------------------------------------------------------------------ 29 | 30 | ::oo::class create ::tdbc::sqlite3::connection { 31 | 32 | superclass ::tdbc::connection 33 | 34 | variable timeout 35 | 36 | # The constructor accepts a database name and opens the database. 37 | 38 | constructor {databaseName args} { 39 | set timeout 0 40 | if {[llength $args] % 2 != 0} { 41 | set cmd [lrange [info level 0] 0 end-[llength $args]] 42 | return -code error \ 43 | -errorcode {TDBC GENERAL_ERROR HY000 SQLITE3 WRONGNUMARGS} \ 44 | "wrong # args, should be \"$cmd ?-option value?...\"" 45 | } 46 | next 47 | sqlite3 [namespace current]::db $databaseName 48 | if {[llength $args] > 0} { 49 | my configure {*}$args 50 | } 51 | db nullvalue \ufffd 52 | } 53 | 54 | # The 'statementCreate' method forwards to the constructor of the 55 | # statement class 56 | 57 | forward statementCreate ::tdbc::sqlite3::statement create 58 | 59 | # The 'configure' method queries and sets options to the database 60 | 61 | method configure args { 62 | if {[llength $args] == 0} { 63 | 64 | # Query all configuration options 65 | 66 | set result {-encoding utf-8} 67 | lappend result -isolation 68 | if {[db onecolumn {PRAGMA read_uncommitted}]} { 69 | lappend result readuncommitted 70 | } else { 71 | lappend result serializable 72 | } 73 | lappend result -readonly 0 74 | lappend result -timeout $timeout 75 | return $result 76 | 77 | } elseif {[llength $args] == 1} { 78 | 79 | # Query a single option 80 | 81 | set option [lindex $args 0] 82 | switch -exact -- $option { 83 | -e - -en - -enc - -enco - -encod - -encodi - -encodin - 84 | -encoding { 85 | return utf-8 86 | } 87 | -i - -is - -iso - -isol - -isola - -isolat - -isolati - 88 | -isolatio - -isolation { 89 | if {[db onecolumn {PRAGMA read_uncommitted}]} { 90 | return readuncommitted 91 | } else { 92 | return serializable 93 | } 94 | } 95 | -r - -re - -rea - -read - -reado - -readon - -readonl - 96 | -readonly { 97 | return 0 98 | } 99 | -t - -ti - -tim - -time - -timeo - -timeou - -timeout { 100 | return $timeout 101 | } 102 | default { 103 | return -code error \ 104 | -errorcode [list TDBC GENERAL_ERROR HY000 SQLITE3 \ 105 | BADOPTION $option] \ 106 | "bad option \"$option\": must be\ 107 | -encoding, -isolation, -readonly or -timeout" 108 | 109 | } 110 | } 111 | 112 | } elseif {[llength $args] % 2 != 0} { 113 | 114 | # Syntax error 115 | 116 | set cmd [lrange [info level 0] 0 end-[llength $args]] 117 | return -code error \ 118 | -errorcode [list TDBC GENERAL_ERROR HY000 \ 119 | SQLITE3 WRONGNUMARGS] \ 120 | "wrong # args, should be \" $cmd ?-option value?...\"" 121 | } 122 | 123 | # Set one or more options 124 | 125 | foreach {option value} $args { 126 | switch -exact -- $option { 127 | -e - -en - -enc - -enco - -encod - -encodi - -encodin - 128 | -encoding { 129 | if {$value ne {utf-8}} { 130 | return -code error \ 131 | -errorcode [list TDBC FEATURE_NOT_SUPPORTED 0A000 \ 132 | SQLITE3 ENCODING] \ 133 | "-encoding not supported. SQLite3 is always \ 134 | Unicode." 135 | } 136 | } 137 | -i - -is - -iso - -isol - -isola - -isolat - -isolati - 138 | -isolatio - -isolation { 139 | switch -exact -- $value { 140 | readu - readun - readunc - readunco - readuncom - 141 | readuncomm - readuncommi - readuncommit - 142 | readuncommitt - readuncommitte - readuncommitted { 143 | db eval {PRAGMA read_uncommitted = 1} 144 | } 145 | readc - readco - readcom - readcomm - readcommi - 146 | readcommit - readcommitt - readcommitte - 147 | readcommitted - 148 | rep - repe - repea - repeat - repeata - repeatab - 149 | repeatabl - repeatable - repeatabler - repeatablere - 150 | repeatablerea - repeatablread - 151 | s - se - ser - seri - seria - serial - seriali - 152 | serializ - serializa - serializab - serializabl - 153 | serializable - 154 | reado - readon - readonl - readonly { 155 | db eval {PRAGMA read_uncommitted = 0} 156 | } 157 | default { 158 | return -code error \ 159 | -errorcode [list TDBC GENERAL_ERROR HY000 \ 160 | SQLITE3 BADISOLATION $value] \ 161 | "bad isolation level \"$value\":\ 162 | should be readuncommitted, readcommitted,\ 163 | repeatableread, serializable, or readonly" 164 | } 165 | } 166 | } 167 | -r - -re - -rea - -read - -reado - -readon - -readonl - 168 | -readonly { 169 | if {$value} { 170 | return -code error \ 171 | -errorcode [list TDBC FEATURE_NOT_SUPPORTED 0A000 \ 172 | SQLITE3 READONLY] \ 173 | "SQLite3's Tcl API does not support read-only\ 174 | access" 175 | } 176 | } 177 | -t - -ti - -tim - -time - -timeo - -timeou - -timeout { 178 | if {![string is integer $value]} { 179 | return -code error \ 180 | -errorcode [list TDBC DATA_EXCEPTION 22018 \ 181 | SQLITE3 $value] \ 182 | "expected integer but got \"$value\"" 183 | } 184 | db timeout $value 185 | set timeout $value 186 | } 187 | default { 188 | return -code error \ 189 | -errorcode [list TDBC GENERAL_ERROR HY000 \ 190 | SQLITE3 BADOPTION $value] \ 191 | "bad option \"$option\": must be\ 192 | -encoding, -isolation, -readonly or -timeout" 193 | 194 | } 195 | } 196 | } 197 | return 198 | } 199 | 200 | # The 'tables' method introspects on the tables in the database. 201 | 202 | method tables {{pattern %}} { 203 | set retval {} 204 | my foreach row { 205 | SELECT * from sqlite_master 206 | WHERE type IN ('table', 'view') 207 | AND name LIKE :pattern 208 | } { 209 | dict set row name [string tolower [dict get $row name]] 210 | dict set retval [dict get $row name] $row 211 | } 212 | return $retval 213 | } 214 | 215 | # The 'columns' method introspects on columns of a table. 216 | 217 | method columns {table {pattern %}} { 218 | regsub -all ' $table '' table 219 | set retval {} 220 | set pattern [string map [list \ 221 | * {[*]} \ 222 | ? {[?]} \ 223 | \[ \\\[ \ 224 | \] \\\[ \ 225 | _ ? \ 226 | % *] [string tolower $pattern]] 227 | my foreach origrow "PRAGMA table_info('$table')" { 228 | set row {} 229 | dict for {key value} $origrow { 230 | dict set row [string tolower $key] $value 231 | } 232 | dict set row name [string tolower [dict get $row name]] 233 | if {![string match $pattern [dict get $row name]]} { 234 | continue 235 | } 236 | switch -regexp -matchvar info [dict get $row type] { 237 | {^(.+)\(\s*([[:digit:]]+)\s*,\s*([[:digit:]]+)\s*\)\s*$} { 238 | dict set row type [string tolower [lindex $info 1]] 239 | dict set row precision [lindex $info 2] 240 | dict set row scale [lindex $info 3] 241 | } 242 | {^(.+)\(\s*([[:digit:]]+)\s*\)\s*$} { 243 | dict set row type [string tolower [lindex $info 1]] 244 | dict set row precision [lindex $info 2] 245 | dict set row scale 0 246 | } 247 | default { 248 | dict set row type [string tolower [dict get $row type]] 249 | dict set row precision 0 250 | dict set row scale 0 251 | } 252 | } 253 | dict set row nullable [expr {![dict get $row notnull]}] 254 | dict set retval [dict get $row name] $row 255 | } 256 | return $retval 257 | } 258 | 259 | # The 'primarykeys' method enumerates the primary keys on a table. 260 | 261 | method primarykeys {table} { 262 | set result {} 263 | my foreach row "PRAGMA table_info($table)" { 264 | if {[dict get $row pk]} { 265 | lappend result [dict create ordinalPosition \ 266 | [expr {[dict get $row cid]+1}] \ 267 | columnName \ 268 | [dict get $row name]] 269 | } 270 | } 271 | return $result 272 | } 273 | 274 | # The 'foreignkeys' method enumerates the foreign keys that are 275 | # declared in a table or that refer to a given table. 276 | 277 | method foreignkeys {args} { 278 | 279 | variable ::tdbc::generalError 280 | 281 | # Check arguments 282 | 283 | set argdict {} 284 | if {[llength $args] % 2 != 0} { 285 | set errorcode $generalError 286 | lappend errorcode wrongNumArgs 287 | return -code error -errorcode $errorcode \ 288 | "wrong # args: should be [lrange [info level 0] 0 1]\ 289 | ?-option value?..." 290 | } 291 | foreach {key value} $args { 292 | if {$key ni {-primary -foreign}} { 293 | set errorcode $generalError 294 | lappend errorcode badOption 295 | return -code error -errorcode $errorcode \ 296 | "bad option \"$key\", must be -primary or -foreign" 297 | } 298 | set key [string range $key 1 end] 299 | if {[dict exists $argdict $key]} { 300 | set errorcode $generalError 301 | lappend errorcode dupOption 302 | return -code error -errorcode $errorcode \ 303 | "duplicate option \"$key\" supplied" 304 | } 305 | dict set argdict $key $value 306 | } 307 | 308 | # If we know the table with the foreign key, search just its 309 | # foreign keys. Otherwise, iterate over all the tables in the 310 | # database. 311 | 312 | if {[dict exists $argdict foreign]} { 313 | return [my ForeignKeysForTable [dict get $argdict foreign] \ 314 | $argdict] 315 | } else { 316 | set result {} 317 | foreach foreignTable [dict keys [my tables]] { 318 | lappend result {*}[my ForeignKeysForTable \ 319 | $foreignTable $argdict] 320 | } 321 | return $result 322 | } 323 | 324 | } 325 | 326 | # The private ForeignKeysForTable method enumerates the foreign keys 327 | # in a specific table. 328 | # 329 | # Parameters: 330 | # 331 | # foreignTable - Name of the table containing foreign keys. 332 | # argdict - Dictionary that may or may not contain a key, 333 | # 'primary', whose value is the name of a table that 334 | # must hold the primary key corresponding to the foreign 335 | # key. If the 'primary' key is absent, all tables are 336 | # candidates. 337 | # Results: 338 | # 339 | # Returns the list of foreign keys that meed the specified 340 | # conditions, as a list of dictionaries, each containing the 341 | # keys, foreignConstraintName, foreignTable, foreignColumn, 342 | # primaryTable, primaryColumn, and ordinalPosition. Note that the 343 | # foreign constraint name is constructed arbitrarily, since SQLite3 344 | # does not report this information. 345 | 346 | method ForeignKeysForTable {foreignTable argdict} { 347 | 348 | set result {} 349 | set n 0 350 | 351 | # Go through the foreign keys in the given table, looking for 352 | # ones that refer to the primary table (if one is given), or 353 | # for any primary keys if none is given. 354 | my foreach row "PRAGMA foreign_key_list($foreignTable)" { 355 | if {(![dict exists $argdict primary]) 356 | || ([string tolower [dict get $row table]] 357 | eq [dict get $argdict primary])} { 358 | 359 | # Construct a dictionary for each key, translating 360 | # SQLite names to TDBC ones and converting sequence 361 | # numbers to 1-based indexing. 362 | 363 | set rrow [dict create foreignTable $foreignTable \ 364 | foreignConstraintName \ 365 | ?$foreignTable?[dict get $row id]] 366 | if {[dict exists $row seq]} { 367 | dict set rrow ordinalPosition \ 368 | [expr {1 + [dict get $row seq]}] 369 | } 370 | foreach {to from} { 371 | foreignColumn from 372 | primaryTable table 373 | primaryColumn to 374 | deleteAction on_delete 375 | updateAction on_update 376 | } { 377 | if {[dict exists $row $from]} { 378 | dict set rrow $to [dict get $row $from] 379 | } 380 | } 381 | 382 | # Add the newly-constucted dictionary to the result list 383 | 384 | lappend result $rrow 385 | } 386 | } 387 | 388 | return $result 389 | } 390 | 391 | # The 'preparecall' method prepares a call to a stored procedure. 392 | # SQLite3 does not have stored procedures, since it's an in-process 393 | # server. 394 | 395 | method preparecall {call} { 396 | return -code error \ 397 | -errorcode [list TDBC FEATURE_NOT_SUPPORTED 0A000 \ 398 | SQLITE3 PREPARECALL] \ 399 | {SQLite3 does not support stored procedures} 400 | } 401 | 402 | # The 'begintransaction' method launches a database transaction 403 | 404 | method begintransaction {} { 405 | db eval {BEGIN TRANSACTION} 406 | } 407 | 408 | # The 'commit' method commits a database transaction 409 | 410 | method commit {} { 411 | db eval {COMMIT} 412 | } 413 | 414 | # The 'rollback' method abandons a database transaction 415 | 416 | method rollback {} { 417 | db eval {ROLLBACK} 418 | } 419 | 420 | # The 'transaction' method executes a script as a single transaction. 421 | # We override the 'transaction' method of the base class, since SQLite3 422 | # has a faster implementation of the same thing. (The base class's generic 423 | # method should also work.) 424 | # (Don't overload the base class method, because 'break', 'continue' 425 | # and 'return' in the transaction body don't work!) 426 | 427 | #method transaction {script} { 428 | # uplevel 1 [list {*}[namespace code db] transaction $script] 429 | #} 430 | 431 | method prepare {sqlCode} { 432 | set result [next $sqlCode] 433 | return $result 434 | } 435 | 436 | method getDBhandle {} { 437 | return [namespace which db] 438 | } 439 | } 440 | 441 | #------------------------------------------------------------------------------ 442 | # 443 | # tdbc::sqlite3::statement -- 444 | # 445 | # Class representing a statement to execute against a SQLite3 database 446 | # 447 | #------------------------------------------------------------------------------ 448 | 449 | ::oo::class create ::tdbc::sqlite3::statement { 450 | 451 | superclass ::tdbc::statement 452 | 453 | variable Params db sql 454 | 455 | # The constructor accepts the handle to the connection and the SQL 456 | # code for the statement to prepare. All that it does is to parse the 457 | # statement and store it. The parse is used to support the 458 | # 'params' and 'paramtype' methods. 459 | 460 | constructor {connection sqlcode} { 461 | next 462 | set Params {} 463 | set db [$connection getDBhandle] 464 | set sql $sqlcode 465 | foreach token [::tdbc::tokenize $sqlcode] { 466 | if {[string index $token 0] in {$ : @}} { 467 | dict set Params [string range $token 1 end] \ 468 | {type Tcl_Obj precision 0 scale 0 nullable 1 direction in} 469 | } 470 | } 471 | } 472 | 473 | # The 'resultSetCreate' method relays to the result set constructor 474 | 475 | forward resultSetCreate ::tdbc::sqlite3::resultset create 476 | 477 | # The 'params' method returns descriptions of the parameters accepted 478 | # by the statement 479 | 480 | method params {} { 481 | return $Params 482 | } 483 | 484 | # The 'paramtype' method need do nothing; Sqlite3 uses manifest typing. 485 | 486 | method paramtype args {;} 487 | 488 | method getDBhandle {} { 489 | return $db 490 | } 491 | 492 | method getSql {} { 493 | return $sql 494 | } 495 | 496 | } 497 | 498 | #------------------------------------------------------------------------------- 499 | # 500 | # tdbc::sqlite3::resultset -- 501 | # 502 | # Class that represents a SQLlite result set in Tcl 503 | # 504 | #------------------------------------------------------------------------------- 505 | 506 | ::oo::class create ::tdbc::sqlite3::resultset { 507 | 508 | superclass ::tdbc::resultset 509 | 510 | # The variables of this class all have peculiar names. The reason is 511 | # that the RunQuery method needs to execute with an activation record 512 | # that has no local variables whose names could conflict with names 513 | # in the SQL query. We start the variable names with hyphens because 514 | # they can't be bind variables. 515 | 516 | variable -set {*}{ 517 | -columns -db -needcolumns -resultArray 518 | -results -sql -Cursor -RowCount -END 519 | } 520 | 521 | constructor {statement args} { 522 | next 523 | set -db [$statement getDBhandle] 524 | set -sql [$statement getSql] 525 | set -columns {} 526 | set -results {} 527 | ${-db} trace [namespace code {my RecordStatement}] 528 | if {[llength $args] == 0} { 529 | 530 | # Variable substitutions are evaluated in caller's context 531 | 532 | uplevel 1 [list ${-db} eval ${-sql} \ 533 | [namespace which -variable -resultArray] \ 534 | [namespace code {my RecordResult}]] 535 | 536 | } elseif {[llength $args] == 1} { 537 | 538 | # Variable substitutions are in the dictionary at [lindex $args 0]. 539 | 540 | set -paramDict [lindex $args 0] 541 | 542 | # At this point, the activation record must contain no variables 543 | # that might be bound within the query. All variables at this point 544 | # begin with hyphens so that they are syntactically incorrect 545 | # as bound variables in SQL. 546 | 547 | unset args 548 | unset statement 549 | 550 | dict with -paramDict { 551 | ${-db} eval ${-sql} -resultArray { 552 | my RecordResult 553 | } 554 | } 555 | 556 | } else { 557 | 558 | ${-db} trace {} 559 | 560 | # Too many args 561 | 562 | return -code error \ 563 | -errorcode [list TDBC GENERAL_ERROR HY000 \ 564 | SQLITE3 WRONGNUMARGS] \ 565 | "wrong # args: should be\ 566 | [lrange [info level 0] 0 1] statement ?dictionary?" 567 | 568 | } 569 | ${-db} trace {} 570 | set -Cursor 0 571 | if {${-Cursor} < [llength ${-results}] 572 | && [lindex ${-results} ${-Cursor}] eq {statement}} { 573 | incr -Cursor 2 574 | } 575 | if {${-Cursor} < [llength ${-results}] 576 | && [lindex ${-results} ${-Cursor}] eq {columns}} { 577 | incr -Cursor 578 | set -columns [lindex ${-results} ${-Cursor}] 579 | incr -Cursor 580 | } 581 | set -RowCount [${-db} changes] 582 | } 583 | 584 | # Record the start of a SQL statement 585 | 586 | method RecordStatement {stmt} { 587 | set -needcolumns 1 588 | lappend -results statement {} 589 | } 590 | 591 | # Record one row of results from a query by appending it as a dictionary 592 | # to the 'results' list. As a side effect, set 'columns' to a list 593 | # comprising the names of the columns of the result. 594 | 595 | method RecordResult {} { 596 | set columns ${-resultArray(*)} 597 | if {[info exists -needcolumns]} { 598 | lappend -results columns $columns 599 | unset -needcolumns 600 | } 601 | set dict {} 602 | foreach key $columns { 603 | if {[set -resultArray($key)] ne "\ufffd"} { 604 | dict set dict $key [set -resultArray($key)] 605 | } 606 | } 607 | lappend -results row $dict 608 | } 609 | 610 | # Advance to the next result set 611 | 612 | method nextresults {} { 613 | set have 0 614 | while {${-Cursor} < [llength ${-results}]} { 615 | if {[lindex ${-results} ${-Cursor}] eq {statement}} { 616 | set have 1 617 | incr -Cursor 2 618 | break 619 | } 620 | incr -Cursor 2 621 | } 622 | if {!$have} { 623 | set -END {} 624 | } 625 | if {${-Cursor} >= [llength ${-results}]} { 626 | set -columns {} 627 | } elseif {[lindex ${-results} ${-Cursor}] eq {columns}} { 628 | incr -Cursor 629 | set -columns [lindex ${-results} ${-Cursor}] 630 | incr -Cursor 631 | } else { 632 | set -columns {} 633 | } 634 | return $have 635 | } 636 | 637 | method getDBhandle {} { 638 | return ${-db} 639 | } 640 | 641 | # Return a list of the columns 642 | 643 | method columns {} { 644 | if {[info exists -END]} { 645 | return -code error \ 646 | -errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \ 647 | "Function sequence error: result set is exhausted." 648 | } 649 | return ${-columns} 650 | } 651 | 652 | # Return the next row of the result set as a list 653 | 654 | method nextlist var { 655 | 656 | upvar 1 $var row 657 | 658 | if {[info exists -END]} { 659 | return -code error \ 660 | -errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \ 661 | "Function sequence error: result set is exhausted." 662 | } 663 | if {${-Cursor} >= [llength ${-results}] 664 | || [lindex ${-results} ${-Cursor}] ne {row}} { 665 | return 0 666 | } else { 667 | set row {} 668 | incr -Cursor 669 | set d [lindex ${-results} ${-Cursor}] 670 | incr -Cursor 671 | foreach key ${-columns} { 672 | if {[dict exists $d $key]} { 673 | lappend row [dict get $d $key] 674 | } else { 675 | lappend row {} 676 | } 677 | } 678 | } 679 | return 1 680 | } 681 | 682 | # Return the next row of the result set as a dict 683 | 684 | method nextdict var { 685 | 686 | upvar 1 $var row 687 | 688 | if {[info exists -END]} { 689 | return -code error \ 690 | -errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \ 691 | "Function sequence error: result set is exhausted." 692 | } 693 | if {${-Cursor} >= [llength ${-results}] 694 | || [lindex ${-results} ${-Cursor}] ne {row}} { 695 | return 0 696 | } else { 697 | incr -Cursor 698 | set row [lindex ${-results} ${-Cursor}] 699 | incr -Cursor 700 | } 701 | return 1 702 | } 703 | 704 | # Return the number of rows affected by a statement 705 | 706 | method rowcount {} { 707 | if {[info exists -END]} { 708 | return -code error \ 709 | -errorcode {TDBC GENERAL_ERROR HY010 SQLITE3 FUNCTIONSEQ} \ 710 | "Function sequence error: result set is exhausted." 711 | } 712 | return ${-RowCount} 713 | } 714 | 715 | } 716 | -------------------------------------------------------------------------------- /tests/tdbcsqlite3.test: -------------------------------------------------------------------------------- 1 | # tdbcsqlite3.test -- 2 | # 3 | # Tests for the tdbc::sqlite3 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: tdbcsqlite3.tcl,v 1.47 2008/02/27 02:08:27 kennykb Exp $ 10 | # 11 | #------------------------------------------------------------------------------ 12 | 13 | lappend auto_path . 14 | if {[lsearch [namespace children] ::tcltest] == -1} { 15 | package require tcltest 2 16 | namespace import -force ::tcltest::* 17 | } 18 | loadTestedCommands 19 | package require tdbc::sqlite3 20 | 21 | # Test setup. We need a database to work on, so copy 'test.mdb' to a 22 | # temp file, and run from it. 23 | 24 | set testdir [makeDirectory tdbctest] 25 | set testFileName test.db 26 | set testDBName [makeFile {} $testFileName $testdir] 27 | catch {file delete -force $testDBName} 28 | 29 | #------------------------------------------------------------------------------- 30 | 31 | test tdbc::sqlite3-1.1 {create a connection, wrong # args} {*}{ 32 | -body { 33 | tdbc::sqlite3::connection create 34 | } 35 | -returnCodes error 36 | -match glob 37 | -result {wrong # args*} 38 | } 39 | 40 | test tdbc::sqlite3-1.2 {create a connection, connection string missing} {*}{ 41 | -body { 42 | tdbc::sqlite3::connection create db 43 | } 44 | -returnCodes error 45 | -match glob 46 | -result {wrong # args*} 47 | } 48 | 49 | test tdbc::sqlite3-1.3 {create a connection, failure} {*}{ 50 | -body { 51 | set status [catch { 52 | tdbc::sqlite3::connection create db /dev/null/wtf 53 | } result] 54 | list $status $result 55 | } 56 | -cleanup {catch {rename db {}}} 57 | -match glob 58 | -result {1 {unable to open database file}} 59 | } 60 | 61 | test tdbc::sqlite3-1.4 {create a connection, successful} {*}{ 62 | -body { 63 | tdbc::sqlite3::connection create ::db $::testDBName 64 | } 65 | -result ::db 66 | -cleanup { 67 | catch {rename ::db {}} 68 | } 69 | } 70 | 71 | #------------------------------------------------------------------------------- 72 | # 73 | # The tests that follow all require a connection to a database. 74 | 75 | tdbc::sqlite3::connection create ::db $::testDBName 76 | 77 | #------------------------------------------------------------------------------- 78 | 79 | test tdbc::sqlite3-2.1 {prepare statement, wrong # args} {*}{ 80 | -body { 81 | ::db prepare 82 | } 83 | -returnCodes error 84 | -match glob 85 | -result {wrong # args*} 86 | } 87 | 88 | test tdbc::sqlite3-2.2 {don't make a statement without a connection} {*}{ 89 | -body { 90 | tdbc::sqlite3::statement create stmt rubbish moreRubbish 91 | } 92 | -returnCodes error 93 | -match glob 94 | -result {invalid command name*} 95 | } 96 | 97 | test tdbc::sqlite3-2.3 {don't make a statement without a connection} {*}{ 98 | -body { 99 | tdbc::sqlite3::statement create stmt oo::class moreRubbish 100 | } 101 | -returnCodes error 102 | -match glob 103 | -result {unknown method*} 104 | } 105 | 106 | test tdbc::sqlite3-3.0 {prepare a valid statement} {*}{ 107 | -body { 108 | set stmt [::db prepare { 109 | CREATE TABLE people( 110 | idnum INTEGER PRIMARY KEY, 111 | name VARCHAR(40) NOT NULL 112 | ) 113 | }] 114 | } 115 | -match glob 116 | -result *Stmt* 117 | -cleanup { 118 | catch [rename $stmt {}] 119 | } 120 | } 121 | 122 | test tdbc::sqlite3-3.1 {execute a valid statement with no results} {*}{ 123 | -body { 124 | set stmt [::db prepare { 125 | CREATE TABLE people( 126 | idnum INTEGER PRIMARY KEY, 127 | name VARCHAR(40) NOT NULL 128 | ) 129 | }] 130 | set rs [$stmt execute] 131 | list [expr {[$rs rowcount] <= 0}] [$rs columns] [$rs nextrow nothing] 132 | } 133 | -result {1 {} 0} 134 | -cleanup { 135 | catch { 136 | rename $rs {} 137 | rename $stmt {} 138 | set stmt [::db prepare { 139 | DROP TABLE people 140 | }] 141 | set rs [$stmt execute] 142 | rename $rs {} 143 | rename $stmt {} 144 | } 145 | } 146 | } 147 | 148 | test tdbc::sqlite3-3.2 {result set: wrong # args} {*}{ 149 | -body { 150 | set stmt [::db prepare { 151 | CREATE TABLE people( 152 | idnum INTEGER PRIMARY KEY, 153 | name VARCHAR(40) NOT NULL 154 | ) 155 | }] 156 | $stmt execute with extra args 157 | } 158 | -returnCodes error 159 | -match glob 160 | -result {wrong # args*} 161 | -cleanup { 162 | catch [rename $stmt {}] 163 | } 164 | } 165 | 166 | test tdbc::sqlite3-3.3 {result set: trying to create against a non-object} {*}{ 167 | -body { 168 | tdbc::sqlite3::resultset create rs nothing 169 | } 170 | -returnCodes error 171 | -match glob 172 | -result {invalid command name*} 173 | } 174 | 175 | test tdbc::sqlite3-3.4 {result set: trying to create against a non-statement} {*}{ 176 | -body { 177 | tdbc::sqlite3::resultset create rs db 178 | } 179 | -returnCodes error 180 | -match glob 181 | -result {unknown method*} 182 | } 183 | 184 | #------------------------------------------------------------------------------- 185 | # 186 | # Following tests need a 'people' table in the database 187 | 188 | set stmt [::db prepare { 189 | CREATE TABLE people( 190 | idnum INTEGER PRIMARY KEY, 191 | name VARCHAR(40) NOT NULL, 192 | info INTEGER 193 | ) 194 | }] 195 | set rs [$stmt execute] 196 | rename $rs {} 197 | rename $stmt {} 198 | 199 | test tdbc::sqlite3-4.1 {execute an insert with no params} {*}{ 200 | -body { 201 | set stmt [::db prepare { 202 | INSERT INTO people(idnum, name, info) values(1, 'fred', 0) 203 | }] 204 | set rs [$stmt execute] 205 | list [$rs rowcount] [$rs columns] [$rs nextrow nothing] 206 | } 207 | -result {1 {} 0} 208 | -cleanup { 209 | catch { 210 | rename $rs {} 211 | rename $stmt {} 212 | set stmt [::db prepare { 213 | DELETE FROM people 214 | }] 215 | set rs [$stmt execute] 216 | rename $rs {} 217 | rename $stmt {} 218 | } 219 | } 220 | } 221 | 222 | test tdbc::sqlite3-4.2 {execute an insert with variable parameters} {*}{ 223 | -body { 224 | set stmt [::db prepare { 225 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 226 | }] 227 | $stmt paramtype idnum integer 228 | $stmt paramtype name varchar 40 229 | set idnum 1 230 | set name fred 231 | set rs [$stmt execute] 232 | list [$rs rowcount] [$rs columns] [$rs nextrow nothing] 233 | } 234 | -result {1 {} 0} 235 | -cleanup { 236 | catch { 237 | rename $rs {} 238 | rename $stmt {} 239 | set stmt [::db prepare { 240 | DELETE FROM people 241 | }] 242 | set rs [$stmt execute] 243 | rename $rs {} 244 | rename $stmt {} 245 | } 246 | } 247 | } 248 | 249 | test tdbc::sqlite3-4.3 {execute an insert with dictionary parameters} {*}{ 250 | -body { 251 | set stmt [::db prepare { 252 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 253 | }] 254 | $stmt paramtype idnum integer 255 | $stmt paramtype name varchar 40 256 | set rs [$stmt execute {idnum 1 name fred}] 257 | list [$rs rowcount] [$rs columns] [$rs nextrow nothing] 258 | } 259 | -result {1 {} 0} 260 | -cleanup { 261 | catch { 262 | rename $rs {} 263 | rename $stmt {} 264 | set stmt [::db prepare { 265 | DELETE FROM people 266 | }] 267 | set rs [$stmt execute] 268 | rename $rs {} 269 | rename $stmt {} 270 | } 271 | } 272 | } 273 | 274 | test tdbc::sqlite3-4.4 {bad dictionary} {*}{ 275 | -body { 276 | set stmt [::db prepare { 277 | INSERT INTO people(idnum, name, info) values(:idnum, :name) 278 | }] 279 | $stmt paramtype idnum integer 280 | $stmt paramtype name varchar 40 281 | $stmt execute {idnum 1 name} 282 | } 283 | -returnCodes error 284 | -result {missing value to go with key} 285 | -cleanup { 286 | catch { 287 | rename $stmt {} 288 | set stmt [::db prepare { 289 | DELETE FROM people 290 | }] 291 | set rs [$stmt execute] 292 | rename $rs {} 293 | rename $stmt {} 294 | } 295 | } 296 | } 297 | 298 | test tdbc::sqlite3-4.7 {missing parameter - nullable} {*}{ 299 | -setup { 300 | catch {unset info} 301 | set stmt [::db prepare { 302 | INSERT INTO people(idnum, name, info) values(:idnum, :name, :info) 303 | }] 304 | $stmt paramtype idnum integer 305 | $stmt paramtype name varchar 40 306 | $stmt paramtype info integer 307 | set stmt2 [::db prepare { 308 | SELECT name, info FROM people WHERE idnum = :idnum 309 | }] 310 | $stmt2 paramtype idnum integer 311 | } 312 | -body { 313 | set name "mr. gravel" 314 | set idnum 100 315 | set rs [$stmt execute] 316 | rename $rs {} 317 | set rs [$stmt2 execute] 318 | $rs nextrow -as dicts row 319 | set row 320 | } 321 | -result {name {mr. gravel}} 322 | -cleanup { 323 | catch {rename $rs {}} 324 | catch { 325 | rename $stmt {} 326 | rename $stmt2 {} 327 | set stmt [::db prepare { 328 | DELETE FROM people 329 | }] 330 | set rs [$stmt execute] 331 | rename $rs {} 332 | rename $stmt {} 333 | } 334 | } 335 | } 336 | 337 | test tdbc::sqlite3-4.8 {missing parameter in dictionary - nullable} {*}{ 338 | -setup { 339 | set stmt [::db prepare { 340 | INSERT INTO people(idnum, name, info) values(:idnum, :name, :info) 341 | }] 342 | $stmt paramtype idnum integer 343 | $stmt paramtype name varchar 40 344 | $stmt paramtype info integer 345 | set stmt2 [::db prepare { 346 | SELECT name, info FROM people WHERE idnum = :idnum 347 | }] 348 | $stmt2 paramtype idnum integer 349 | } 350 | -body { 351 | set rs [$stmt execute {name {gary granite} idnum 200}] 352 | rename $rs {} 353 | set rs [$stmt2 execute {idnum 200}] 354 | $rs nextrow -as dicts row 355 | set row 356 | } 357 | -result {name {gary granite}} 358 | -cleanup { 359 | catch {rename $rs {}} 360 | catch { 361 | rename $stmt {} 362 | rename $stmt2 {} 363 | set stmt [::db prepare { 364 | DELETE FROM people 365 | }] 366 | set rs [$stmt execute] 367 | rename $rs {} 368 | rename $stmt {} 369 | } 370 | } 371 | } 372 | 373 | test tdbc::sqlite3-4.9 {two result sets open against the same statement} {*}{ 374 | -body { 375 | set stmt [::db prepare { 376 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 377 | }] 378 | $stmt paramtype idnum integer 379 | $stmt paramtype name varchar 40 380 | set rs1 [$stmt execute {idnum 1 name fred}] 381 | set rs2 [$stmt execute {idnum 2 name wilma}] 382 | list [$rs1 rowcount] [$rs1 columns] [$rs1 nextrow nothing] \ 383 | [$rs2 rowcount] [$rs2 columns] [$rs2 nextrow nothing] 384 | } 385 | -result {1 {} 0 1 {} 0} 386 | -cleanup { 387 | catch { 388 | rename $rs1 {} 389 | rename $rs2 {} 390 | rename $stmt {} 391 | set stmt [::db prepare { 392 | DELETE FROM people 393 | }] 394 | set rs [$stmt execute] 395 | rename $rs {} 396 | rename $stmt {} 397 | } 398 | } 399 | } 400 | 401 | test tdbc::sqlite3-4.10 {failed execution} {*}{ 402 | -setup { 403 | set stmt [::db prepare { 404 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 405 | }] 406 | $stmt paramtype idnum integer 407 | $stmt paramtype name varchar 40 408 | set rs [$stmt execute {idnum 1 name fred}] 409 | rename $rs {} 410 | } 411 | -body { 412 | set status [catch {$stmt execute {idnum 1 name barney}} result] 413 | list $status $result 414 | } 415 | -cleanup { 416 | rename $stmt {} 417 | set stmt [::db prepare { 418 | DELETE FROM people 419 | }] 420 | set rs [$stmt execute] 421 | rename $rs {} 422 | rename $stmt {} 423 | } 424 | -result {1 {PRIMARY KEY must be unique}} 425 | } 426 | 427 | if 0 { 428 | 429 | # following tests check error syntax for 'paramtype' - and tdbcsqlite3 430 | # ignores paramtype, so they're kind of meaningless 431 | 432 | test tdbc::sqlite3-5.1 {paramtype - too few args} {*}{ 433 | -setup { 434 | set stmt [::db prepare { 435 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 436 | }] 437 | } 438 | -body { 439 | $stmt paramtype idnum 440 | } 441 | -cleanup { 442 | rename $stmt {} 443 | } 444 | -returnCodes error 445 | -match glob 446 | -result {wrong # args*} 447 | } 448 | 449 | test tdbc::sqlite3-5.2 {paramtype - just a direction} {*}{ 450 | -setup { 451 | set stmt [::db prepare { 452 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 453 | }] 454 | } 455 | -body { 456 | $stmt paramtype idnum in 457 | } 458 | -cleanup { 459 | rename $stmt {} 460 | } 461 | -returnCodes error 462 | -match glob 463 | -result {wrong # args*} 464 | } 465 | 466 | test tdbc::sqlite3-5.3 {paramtype - bad type} {*}{ 467 | -setup { 468 | set stmt [::db prepare { 469 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 470 | }] 471 | } 472 | -body { 473 | $stmt paramtype idnum rubbish 474 | } 475 | -cleanup { 476 | rename $stmt {} 477 | } 478 | -returnCodes error 479 | -match glob 480 | -result {bad SQL data type "rubbish":*} 481 | } 482 | 483 | test tdbc::sqlite3-5.4 {paramtype - bad scale} {*}{ 484 | -setup { 485 | set stmt [::db prepare { 486 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 487 | }] 488 | } 489 | -body { 490 | $stmt paramtype idnum decimal rubbish 491 | } 492 | -cleanup { 493 | rename $stmt {} 494 | } 495 | -returnCodes error 496 | -match glob 497 | -result {expected integer but got "rubbish"} 498 | } 499 | 500 | test tdbc::sqlite3-5.5 {paramtype - bad precision} {*}{ 501 | -setup { 502 | set stmt [::db prepare { 503 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 504 | }] 505 | } 506 | -body { 507 | $stmt paramtype idnum decimal 12 rubbish 508 | } 509 | -cleanup { 510 | rename $stmt {} 511 | } 512 | -returnCodes error 513 | -match glob 514 | -result {expected integer but got "rubbish"} 515 | } 516 | 517 | test tdbc::sqlite3-5.6 {paramtype - unknown parameter} {*}{ 518 | -setup { 519 | set stmt [::db prepare { 520 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 521 | }] 522 | } 523 | -body { 524 | $stmt paramtype rubbish integer 525 | } 526 | -cleanup { 527 | rename $stmt {} 528 | } 529 | -returnCodes error 530 | -match glob 531 | -result {unknown parameter "rubbish":*} 532 | } 533 | } 534 | test tdbc::sqlite3-6.1 {rowcount - wrong args} {*}{ 535 | -setup { 536 | set stmt [::db prepare { 537 | INSERT INTO people(idnum, name, info) values(:idnum, :name, 0) 538 | }] 539 | $stmt paramtype idnum integer 540 | $stmt paramtype name varchar 40 541 | set rs [$stmt execute {idnum 1 name fred}] 542 | } 543 | -body { 544 | $rs rowcount rubbish 545 | } 546 | -cleanup { 547 | rename $rs {} 548 | rename $stmt {} 549 | set stmt [::db prepare { 550 | DELETE FROM people 551 | }] 552 | set rs [$stmt execute] 553 | rename $rs {} 554 | rename $stmt {} 555 | } 556 | -returnCodes error 557 | -match glob 558 | -result "wrong \# args*" 559 | } 560 | 561 | #------------------------------------------------------------------------------- 562 | # 563 | # next tests require data in the database 564 | 565 | catch { 566 | set stmt [db prepare { 567 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 568 | }] 569 | $stmt paramtype idnum integer 570 | $stmt paramtype name varchar 40 571 | set idnum 1 572 | foreach name {fred wilma pebbles barney betty bam-bam} { 573 | set rs [$stmt execute] 574 | rename $rs {} 575 | incr idnum 576 | } 577 | rename $stmt {} 578 | } 579 | 580 | #------------------------------------------------------------------------------- 581 | 582 | test tdbc::sqlite3-7.1 {columns - bad args} {*}{ 583 | -setup { 584 | set stmt [::db prepare { 585 | SELECT * FROM people 586 | }] 587 | set rs [$stmt execute] 588 | } 589 | -body { 590 | $rs columns rubbish 591 | } 592 | -cleanup { 593 | rename $rs {} 594 | rename $stmt {} 595 | } 596 | -returnCodes error 597 | -match glob 598 | -result {wrong # args*} 599 | } 600 | 601 | test tdbc::sqlite3-7.2 {columns - get column names} {*}{ 602 | -setup { 603 | set stmt [::db prepare { 604 | SELECT * FROM people 605 | }] 606 | set rs [$stmt execute] 607 | } 608 | -body { 609 | $rs columns 610 | } 611 | -cleanup { 612 | rename $rs {} 613 | rename $stmt {} 614 | } 615 | -result {idnum name info} 616 | } 617 | 618 | test tdbc::sqlite3-8.1 {nextrow - as dicts} {*}{ 619 | -setup { 620 | set stmt [::db prepare { 621 | SELECT idnum, name FROM people ORDER BY idnum 622 | }] 623 | set rs [$stmt execute] 624 | } 625 | -body { 626 | set idnum 1 627 | set names {} 628 | while {[$rs nextrow -- row]} { 629 | if {$idnum != [dict get $row idnum]} { 630 | error [list bad idnum [dict get $row idnum] should be $idnum] 631 | } 632 | lappend names [dict get $row name] 633 | incr idnum 634 | } 635 | set names 636 | } 637 | -cleanup { 638 | rename $rs {} 639 | rename $stmt {} 640 | } 641 | -result {fred wilma pebbles barney betty bam-bam} 642 | } 643 | 644 | test tdbc::sqlite3-8.2 {nextrow - as lists} {*}{ 645 | -setup { 646 | set stmt [::db prepare { 647 | SELECT idnum, name FROM people ORDER BY idnum 648 | }] 649 | set rs [$stmt execute] 650 | } 651 | -body { 652 | set idnum 1 653 | set names {} 654 | while {[$rs nextrow -as lists -- row]} { 655 | if {$idnum != [lindex $row 0]} { 656 | error [list bad idnum [lindex $row 0] should be $idnum] 657 | } 658 | lappend names [lindex $row 1] 659 | incr idnum 660 | } 661 | set names 662 | } 663 | -cleanup { 664 | rename $rs {} 665 | rename $stmt {} 666 | } 667 | -result {fred wilma pebbles barney betty bam-bam} 668 | } 669 | 670 | test tdbc::sqlite3-8.3 {nextrow - bad cursor state} {*}{ 671 | -setup { 672 | set stmt [::db prepare { 673 | SELECT idnum, name FROM people ORDER BY idnum 674 | }] 675 | } 676 | -body { 677 | set rs [$stmt execute] 678 | set names {} 679 | while {[$rs nextrow row]} {} 680 | $rs nextrow row 681 | } 682 | -cleanup { 683 | rename $rs {} 684 | rename $stmt {} 685 | } 686 | -result 0 687 | } 688 | 689 | test tdbc::sqlite3-8.4 {anonymous columns - dicts} {*}{ 690 | -setup { 691 | set stmt [::db prepare { 692 | SELECT COUNT(*), MAX(idnum) FROM people 693 | }] 694 | set rs [$stmt execute] 695 | } 696 | -body { 697 | list \ 698 | [$rs nextrow row] \ 699 | $row \ 700 | [$rs nextrow row] 701 | } 702 | -cleanup { 703 | $stmt close 704 | } 705 | -match glob 706 | -result {1 {* 6 * 6} 0} 707 | }; 708 | 709 | test tdbc::sqlite3-8.5 {anonymous columns - lists} {*}{ 710 | -setup { 711 | set stmt [::db prepare { 712 | SELECT COUNT(*), MAX(idnum) FROM people 713 | }] 714 | set rs [$stmt execute] 715 | } 716 | -body { 717 | list [$rs nextrow -as lists row] \ 718 | $row \ 719 | [$rs nextrow -as lists row] 720 | } 721 | -cleanup { 722 | $stmt close 723 | } 724 | -result {1 {6 6} 0} 725 | }; 726 | 727 | test tdbc::sqlite3-8.6 {null results - dicts} {*}{ 728 | -setup { 729 | set stmt [::db prepare { 730 | SELECT idnum, name, info FROM people WHERE name = 'fred' 731 | }] 732 | set rs [$stmt execute] 733 | } 734 | -body { 735 | list [$rs nextrow row] $row [$rs nextrow row] 736 | } 737 | -cleanup { 738 | $stmt close 739 | } 740 | -result {1 {idnum 1 name fred} 0} 741 | } 742 | 743 | test tdbc::sqlite3-8.7 {null results - lists} {*}{ 744 | -setup { 745 | set stmt [::db prepare { 746 | SELECT idnum, name, info FROM people WHERE name = 'fred' 747 | }] 748 | set rs [$stmt execute] 749 | } 750 | -body { 751 | list [$rs nextrow -as lists -- row] $row [$rs nextrow -as lists -- row] 752 | } 753 | -cleanup { 754 | $stmt close 755 | } 756 | -result {1 {1 fred {}} 0} 757 | } 758 | 759 | test tdbc::sqlite3-9.1 {rs foreach var script} {*}{ 760 | -setup { 761 | set stmt [::db prepare { 762 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 763 | }] 764 | set rs [$stmt execute] 765 | } 766 | -body { 767 | set result {} 768 | $rs foreach row { 769 | lappend result $row 770 | } 771 | set result 772 | } 773 | -cleanup { 774 | $rs close 775 | $stmt close 776 | } 777 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 778 | } 779 | 780 | test tdbc::sqlite3-9.2 {stmt foreach var script} {*}{ 781 | -setup { 782 | set stmt [::db prepare { 783 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 784 | }] 785 | 786 | } 787 | -body { 788 | set result {} 789 | $stmt foreach row { 790 | lappend result $row 791 | } 792 | set result 793 | } 794 | -cleanup { 795 | $stmt close 796 | } 797 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 798 | } 799 | 800 | test tdbc::sqlite3-9.3 {db foreach var sqlcode script} {*}{ 801 | -body { 802 | set result {} 803 | db foreach row { 804 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 805 | } { 806 | lappend result $row 807 | } 808 | set result 809 | } 810 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 811 | } 812 | 813 | test tdbc::sqlite3-9.4 {rs foreach -- var script} {*}{ 814 | -setup { 815 | set stmt [::db prepare { 816 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 817 | }] 818 | set rs [$stmt execute] 819 | } 820 | -body { 821 | set result {} 822 | $rs foreach -- row { 823 | lappend result $row 824 | } 825 | set result 826 | } 827 | -cleanup { 828 | $rs close 829 | $stmt close 830 | } 831 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 832 | } 833 | 834 | test tdbc::sqlite3-9.5 {stmt foreach -- var script} {*}{ 835 | -setup { 836 | set stmt [::db prepare { 837 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 838 | }] 839 | } 840 | -body { 841 | set result {} 842 | $stmt foreach -- row { 843 | lappend result $row 844 | } 845 | set result 846 | } 847 | -cleanup { 848 | $stmt close 849 | } 850 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 851 | } 852 | 853 | test tdbc::sqlite3-9.6 {db foreach -- var query script} {*}{ 854 | -body { 855 | set result {} 856 | db foreach -- row { 857 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 858 | } { 859 | lappend result $row 860 | } 861 | set result 862 | } 863 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 864 | } 865 | 866 | test tdbc::sqlite3-9.7 {rs foreach -- -as lists} {*}{ 867 | -setup { 868 | set stmt [::db prepare { 869 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 870 | }] 871 | set rs [$stmt execute] 872 | } 873 | -body { 874 | set result {} 875 | $rs foreach -as lists row { 876 | lappend result $row 877 | } 878 | set result 879 | } 880 | -cleanup { 881 | $rs close 882 | $stmt close 883 | } 884 | -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} 885 | } 886 | 887 | test tdbc::sqlite3-9.8 {stmt foreach -as lists} {*}{ 888 | -setup { 889 | set stmt [::db prepare { 890 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 891 | }] 892 | } 893 | -body { 894 | set result {} 895 | $stmt foreach -as lists row { 896 | lappend result $row 897 | } 898 | set result 899 | } 900 | -cleanup { 901 | $stmt close 902 | } 903 | -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} 904 | } 905 | 906 | test tdbc::sqlite3-9.9 {db foreach -as lists} {*}{ 907 | -body { 908 | set result {} 909 | db foreach -as lists row { 910 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 911 | } { 912 | lappend result $row 913 | } 914 | set result 915 | } 916 | -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} 917 | } 918 | 919 | test tdbc::sqlite3-9.10 {rs foreach -as lists --} {*}{ 920 | -setup { 921 | set stmt [::db prepare { 922 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 923 | }] 924 | set rs [$stmt execute] 925 | } 926 | -body { 927 | set result {} 928 | $rs foreach -as lists -- row { 929 | lappend result $row 930 | } 931 | set result 932 | } 933 | -cleanup { 934 | $rs close 935 | $stmt close 936 | } 937 | -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} 938 | } 939 | 940 | test tdbc::sqlite3-9.11 {stmt foreach -as lists --} {*}{ 941 | -setup { 942 | set stmt [::db prepare { 943 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 944 | }] 945 | } 946 | -body { 947 | set result {} 948 | $stmt foreach -as lists -- row { 949 | lappend result $row 950 | } 951 | set result 952 | } 953 | -cleanup { 954 | $stmt close 955 | } 956 | -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} 957 | } 958 | 959 | test tdbc::sqlite3-9.12 {db foreach -as lists --} {*}{ 960 | -body { 961 | set result {} 962 | db foreach -as lists row { 963 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 964 | } { 965 | lappend result $row 966 | } 967 | set result 968 | } 969 | -result {{4 barney {}} {5 betty {}} {6 bam-bam {}}} 970 | } 971 | 972 | test tdbc::sqlite3-9.13 {rs foreach -as lists -columnsvar c --} {*}{ 973 | -setup { 974 | set stmt [::db prepare { 975 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 976 | }] 977 | set rs [$stmt execute] 978 | } 979 | -body { 980 | set result {} 981 | $rs foreach -as lists -columnsvar c -- row { 982 | foreach cn $c cv $row { 983 | lappend result $cn $cv 984 | } 985 | } 986 | set result 987 | } 988 | -cleanup { 989 | $rs close 990 | $stmt close 991 | } 992 | -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam} 993 | } 994 | 995 | test tdbc::sqlite3-9.14 {stmt foreach -as lists -columnsvar c --} {*}{ 996 | -setup { 997 | set stmt [::db prepare { 998 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 999 | }] 1000 | } 1001 | -body { 1002 | set result {} 1003 | $stmt foreach -as lists -columnsvar c -- row { 1004 | foreach cn $c cv $row { 1005 | lappend result $cn $cv 1006 | } 1007 | } 1008 | set result 1009 | } 1010 | -cleanup { 1011 | $stmt close 1012 | } 1013 | -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam} 1014 | } 1015 | 1016 | test tdbc::sqlite3-9.15 {db foreach -as lists -columnsvar c --} {*}{ 1017 | -body { 1018 | set result {} 1019 | db foreach -as lists -columnsvar c -- row { 1020 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1021 | } { 1022 | foreach cn $c cv $row { 1023 | lappend result $cn $cv 1024 | } 1025 | } 1026 | set result 1027 | } 1028 | -result {idnum 4 name barney idnum 5 name betty idnum 6 name bam-bam} 1029 | } 1030 | 1031 | test tdbc::sqlite3-9.16 {rs foreach / break out of loop} {*}{ 1032 | -setup { 1033 | set stmt [::db prepare { 1034 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 1035 | }] 1036 | set rs [$stmt execute] 1037 | } 1038 | -body { 1039 | set result {} 1040 | $rs foreach -as lists -- row { 1041 | if {[lindex $row 1] eq {betty}} break 1042 | lappend result $row 1043 | } 1044 | set result 1045 | } 1046 | -cleanup { 1047 | $rs close 1048 | $stmt close 1049 | } 1050 | -result {{4 barney {}}} 1051 | } 1052 | 1053 | test tdbc::sqlite3-9.17 {stmt foreach / break out of loop} {*}{ 1054 | -setup { 1055 | set stmt [::db prepare { 1056 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 1057 | }] 1058 | } 1059 | -body { 1060 | set result {} 1061 | $stmt foreach -as lists -- row { 1062 | if {[lindex $row 1] eq {betty}} break 1063 | lappend result $row 1064 | } 1065 | set result 1066 | } 1067 | -cleanup { 1068 | $stmt close 1069 | } 1070 | -result {{4 barney {}}} 1071 | } 1072 | 1073 | test tdbc::sqlite3-9.18 {db foreach / break out of loop} {*}{ 1074 | -body { 1075 | set result {} 1076 | db foreach -as lists -- row { 1077 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 1078 | } { 1079 | if {[lindex $row 1] eq {betty}} break 1080 | lappend result $row 1081 | } 1082 | set result 1083 | } 1084 | -result {{4 barney {}}} 1085 | } 1086 | 1087 | test tdbc::sqlite3-9.19 {rs foreach / continue in loop} {*}{ 1088 | -setup { 1089 | set stmt [::db prepare { 1090 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 1091 | }] 1092 | set rs [$stmt execute] 1093 | } 1094 | -body { 1095 | set result {} 1096 | $rs foreach -as lists -- row { 1097 | if {[lindex $row 1] eq {betty}} continue 1098 | lappend result $row 1099 | } 1100 | set result 1101 | } 1102 | -cleanup { 1103 | $rs close 1104 | $stmt close 1105 | } 1106 | -result {{4 barney {}} {6 bam-bam {}}} 1107 | } 1108 | 1109 | test tdbc::sqlite3-9.20 {stmt foreach / continue in loop} {*}{ 1110 | -setup { 1111 | set stmt [::db prepare { 1112 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 1113 | }] 1114 | } 1115 | -body { 1116 | set result {} 1117 | $stmt foreach -as lists -- row { 1118 | if {[lindex $row 1] eq {betty}} continue 1119 | lappend result $row 1120 | } 1121 | set result 1122 | } 1123 | -cleanup { 1124 | $stmt close 1125 | } 1126 | -result {{4 barney {}} {6 bam-bam {}}} 1127 | } 1128 | 1129 | test tdbc::sqlite3-9.21 {db foreach / continue in loop} {*}{ 1130 | -body { 1131 | set result {} 1132 | db foreach -as lists -- row { 1133 | SELECT idnum, name, info FROM people WHERE name LIKE 'b%' 1134 | } { 1135 | if {[lindex $row 1] eq {betty}} continue 1136 | lappend result $row 1137 | } 1138 | set result 1139 | } 1140 | -result {{4 barney {}} {6 bam-bam {}}} 1141 | } 1142 | 1143 | test tdbc::sqlite3-9.22 {rs foreach / return out of the loop} {*}{ 1144 | -setup { 1145 | set stmt [::db prepare { 1146 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1147 | }] 1148 | set rs [$stmt execute] 1149 | proc tdbc::sqlite3-9.22 {rs} { 1150 | $rs foreach -as lists -- row { 1151 | if {[lindex $row 1] eq {betty}} { 1152 | return [lindex $row 0] 1153 | } 1154 | } 1155 | return failed 1156 | } 1157 | } 1158 | -body { 1159 | tdbc::sqlite3-9.22 $rs 1160 | } 1161 | -cleanup { 1162 | rename tdbc::sqlite3-9.22 {} 1163 | rename $rs {} 1164 | rename $stmt {} 1165 | } 1166 | -result 5 1167 | } 1168 | 1169 | test tdbc::sqlite3-9.23 {stmt foreach / return out of the loop} {*}{ 1170 | -setup { 1171 | set stmt [::db prepare { 1172 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1173 | }] 1174 | proc tdbc::sqlite3-9.23 {stmt} { 1175 | $stmt foreach -as lists -- row { 1176 | if {[lindex $row 1] eq {betty}} { 1177 | return [lindex $row 0] 1178 | } 1179 | } 1180 | return failed 1181 | } 1182 | } 1183 | -body { 1184 | tdbc::sqlite3-9.23 $stmt 1185 | } 1186 | -cleanup { 1187 | rename tdbc::sqlite3-9.23 {} 1188 | rename $stmt {} 1189 | } 1190 | -result 5 1191 | } 1192 | 1193 | test tdbc::sqlite3-9.24 {db foreach / return out of the loop} {*}{ 1194 | -setup { 1195 | proc tdbc::sqlite3-9.24 {stmt} { 1196 | db foreach -as lists -- row { 1197 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1198 | } { 1199 | if {[lindex $row 1] eq {betty}} { 1200 | return [lindex $row 0] 1201 | } 1202 | } 1203 | return failed 1204 | } 1205 | } 1206 | -body { 1207 | tdbc::sqlite3-9.24 $stmt 1208 | } 1209 | -cleanup { 1210 | rename tdbc::sqlite3-9.24 {} 1211 | } 1212 | -result 5 1213 | } 1214 | 1215 | test tdbc::sqlite3-9.25 {rs foreach / error out of the loop} {*}{ 1216 | -setup { 1217 | set stmt [::db prepare { 1218 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1219 | }] 1220 | set rs [$stmt execute] 1221 | proc tdbc::sqlite3-9.25 {rs} { 1222 | $rs foreach -as lists -- row { 1223 | if {[lindex $row 1] eq {betty}} { 1224 | error [lindex $row 0] 1225 | } 1226 | } 1227 | return failed 1228 | } 1229 | } 1230 | -body { 1231 | tdbc::sqlite3-9.25 $rs 1232 | } 1233 | -cleanup { 1234 | rename tdbc::sqlite3-9.25 {} 1235 | rename $rs {} 1236 | rename $stmt {} 1237 | } 1238 | -returnCodes error 1239 | -result 5 1240 | } 1241 | 1242 | test tdbc::sqlite3-9.26 {stmt foreach - error out of the loop} {*}{ 1243 | -setup { 1244 | set stmt [::db prepare { 1245 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1246 | }] 1247 | proc tdbc::sqlite3-9.26 {stmt} { 1248 | $stmt foreach -as lists -- row { 1249 | if {[lindex $row 1] eq {betty}} { 1250 | error [lindex $row 0] 1251 | } 1252 | } 1253 | return failed 1254 | } 1255 | } 1256 | -body { 1257 | tdbc::sqlite3-9.26 $stmt 1258 | } 1259 | -cleanup { 1260 | rename tdbc::sqlite3-9.26 {} 1261 | rename $stmt {} 1262 | } 1263 | -returnCodes error 1264 | -result 5 1265 | } 1266 | 1267 | test tdbc::sqlite3-9.27 {db foreach / error out of the loop} {*}{ 1268 | -setup { 1269 | proc tdbc::sqlite3-9.27 {} { 1270 | db foreach -as lists -- row { 1271 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1272 | } { 1273 | if {[lindex $row 1] eq {betty}} { 1274 | error [lindex $row 0] 1275 | } 1276 | } 1277 | return failed 1278 | } 1279 | } 1280 | -body { 1281 | tdbc::sqlite3-9.27 1282 | } 1283 | -cleanup { 1284 | rename tdbc::sqlite3-9.27 {} 1285 | } 1286 | -returnCodes error 1287 | -result 5 1288 | } 1289 | 1290 | test tdbc::sqlite3-9.28 {rs foreach / unknown status from the loop} {*}{ 1291 | -setup { 1292 | set stmt [::db prepare { 1293 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1294 | }] 1295 | set rs [$stmt execute] 1296 | proc tdbc::sqlite3-9.28 {rs} { 1297 | $rs foreach -as lists -- row { 1298 | if {[lindex $row 1] eq {betty}} { 1299 | return -code 666 -level 0 [lindex $row 0] 1300 | } 1301 | } 1302 | return failed 1303 | } 1304 | } 1305 | -body { 1306 | tdbc::sqlite3-9.28 $rs 1307 | } 1308 | -cleanup { 1309 | rename tdbc::sqlite3-9.28 {} 1310 | rename $rs {} 1311 | rename $stmt {} 1312 | } 1313 | -returnCodes 666 1314 | -result 5 1315 | } 1316 | 1317 | test tdbc::sqlite3-9.29 {stmt foreach / unknown status from the loop} {*}{ 1318 | -setup { 1319 | set stmt [::db prepare { 1320 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1321 | }] 1322 | proc tdbc::sqlite3-9.29 {stmt} { 1323 | $stmt foreach -as lists -- row { 1324 | if {[lindex $row 1] eq {betty}} { 1325 | return -code 666 -level 0 [lindex $row 0] 1326 | } 1327 | } 1328 | return failed 1329 | } 1330 | } 1331 | -body { 1332 | tdbc::sqlite3-9.29 $stmt 1333 | } 1334 | -cleanup { 1335 | rename tdbc::sqlite3-9.29 {} 1336 | rename $stmt {} 1337 | } 1338 | -returnCodes 666 1339 | -result 5 1340 | } 1341 | 1342 | test tdbc::sqlite3-9.30 {db foreach / unknown status from the loop} {*}{ 1343 | -setup { 1344 | proc tdbc::sqlite3-9.30 {stmt} { 1345 | db foreach -as lists -- row { 1346 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1347 | } { 1348 | if {[lindex $row 1] eq {betty}} { 1349 | return -code 666 -level 0 [lindex $row 0] 1350 | } 1351 | } 1352 | return failed 1353 | } 1354 | } 1355 | -body { 1356 | tdbc::sqlite3-9.30 $stmt 1357 | } 1358 | -cleanup { 1359 | rename tdbc::sqlite3-9.30 {} 1360 | } 1361 | -returnCodes 666 1362 | -result 5 1363 | } 1364 | 1365 | test tdbc::sqlite3-9.31 {stmt foreach / params in variables} {*}{ 1366 | -setup { 1367 | set stmt [::db prepare { 1368 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1369 | }] 1370 | $stmt paramtype thePattern varchar 40 1371 | } 1372 | -body { 1373 | set result {} 1374 | set thePattern b% 1375 | $stmt foreach row { 1376 | lappend result $row 1377 | } 1378 | set result 1379 | } 1380 | -cleanup { 1381 | $stmt close 1382 | } 1383 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1384 | } 1385 | 1386 | test tdbc::sqlite3-9.32 {db foreach / params in variables} {*}{ 1387 | -body { 1388 | set result {} 1389 | set thePattern b% 1390 | db foreach row { 1391 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1392 | } { 1393 | lappend result $row 1394 | } 1395 | set result 1396 | } 1397 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1398 | } 1399 | 1400 | test tdbc::sqlite3-9.33 {stmt foreach / parameters in a dictionary} {*}{ 1401 | -setup { 1402 | set stmt [::db prepare { 1403 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1404 | }] 1405 | $stmt paramtype thePattern varchar 40 1406 | } 1407 | -body { 1408 | set result {} 1409 | $stmt foreach row {thePattern b%} { 1410 | lappend result $row 1411 | } 1412 | set result 1413 | } 1414 | -cleanup { 1415 | $stmt close 1416 | } 1417 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1418 | } 1419 | 1420 | test tdbc::sqlite3-9.34 {db foreach / parameters in a dictionary} {*}{ 1421 | -body { 1422 | set result {} 1423 | db foreach row { 1424 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1425 | } {thePattern b%} { 1426 | lappend result $row 1427 | } 1428 | set result 1429 | } 1430 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1431 | } 1432 | 1433 | test tdbc::sqlite3-9.35 {stmt foreach - variable not found} {*}{ 1434 | -setup { 1435 | set stmt [::db prepare { 1436 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1437 | }] 1438 | $stmt paramtype thePattern varchar 40 1439 | catch {unset thePattern} 1440 | } 1441 | -body { 1442 | set result {} 1443 | set thePattern(bogosity) {} 1444 | $stmt foreach row { 1445 | lappend result $row 1446 | } 1447 | set result 1448 | } 1449 | -cleanup { 1450 | unset thePattern 1451 | $stmt close 1452 | } 1453 | -result {} 1454 | } 1455 | 1456 | test tdbc::sqlite3-9.36 {db foreach - variable not found} {*}{ 1457 | -setup { 1458 | catch {unset thePattern} 1459 | } 1460 | -body { 1461 | set result {} 1462 | set thePattern(bogosity) {} 1463 | db foreach row { 1464 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1465 | } { 1466 | lappend result $row 1467 | } 1468 | set result 1469 | } 1470 | -cleanup { 1471 | unset thePattern 1472 | } 1473 | -result {} 1474 | } 1475 | 1476 | test tdbc::sqlite3-9.37 {rs foreach - too few args} {*}{ 1477 | -setup { 1478 | set stmt [::db prepare { 1479 | SELECT idnum, name FROM people 1480 | }] 1481 | set rs [$stmt execute] 1482 | } 1483 | -body { 1484 | $rs foreach row 1485 | } 1486 | -cleanup { 1487 | $rs close 1488 | $stmt close 1489 | } 1490 | -returnCodes error 1491 | -result {wrong # args*} 1492 | -match glob 1493 | } 1494 | 1495 | test tdbc::sqlite3-9.38 {stmt foreach - too few args} {*}{ 1496 | -setup { 1497 | set stmt [::db prepare { 1498 | SELECT idnum, name FROM people 1499 | }] 1500 | } 1501 | -body { 1502 | $stmt foreach row 1503 | } 1504 | -cleanup { 1505 | $stmt close 1506 | } 1507 | -returnCodes error 1508 | -result {wrong # args*} 1509 | -match glob 1510 | } 1511 | 1512 | test tdbc::sqlite3-9.39 {db foreach - too few args} {*}{ 1513 | -body { 1514 | db foreach row { 1515 | SELECT idnum, name FROM people 1516 | } 1517 | } 1518 | -returnCodes error 1519 | -result {wrong # args*} 1520 | -match glob 1521 | } 1522 | 1523 | test tdbc::sqlite3-9.40 {rs foreach - too many args} {*}{ 1524 | -setup { 1525 | set stmt [::db prepare { 1526 | SELECT idnum, name FROM people 1527 | }] 1528 | set rs [$stmt execute] 1529 | } 1530 | -body { 1531 | $rs foreach row do something 1532 | } 1533 | -cleanup { 1534 | $rs close 1535 | $stmt close 1536 | } 1537 | -returnCodes error 1538 | -result {wrong # args*} 1539 | -match glob 1540 | } 1541 | 1542 | test tdbc::sqlite3-9.41 {stmt foreach - too many args} {*}{ 1543 | -setup { 1544 | set stmt [::db prepare { 1545 | SELECT idnum, name FROM people 1546 | }] 1547 | } 1548 | -body { 1549 | $stmt foreach row do something else 1550 | } 1551 | -cleanup { 1552 | $stmt close 1553 | } 1554 | -returnCodes error 1555 | -result {wrong # args*} 1556 | -match glob 1557 | } 1558 | 1559 | test tdbc::sqlite3-9.42 {db foreach - too many args} {*}{ 1560 | -body { 1561 | db foreach row { 1562 | SELECT idnum, name FROM people 1563 | } {} do something 1564 | } 1565 | -returnCodes error 1566 | -result {wrong # args*} 1567 | -match glob 1568 | } 1569 | 1570 | test tdbc::sqlite3-10.1 {allrows - no args} {*}{ 1571 | -setup { 1572 | set stmt [::db prepare { 1573 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1574 | }] 1575 | set rs [$stmt execute] 1576 | } 1577 | -body { 1578 | $rs allrows 1579 | } 1580 | -cleanup { 1581 | rename $rs {} 1582 | rename $stmt {} 1583 | } 1584 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1585 | } 1586 | 1587 | test tdbc::sqlite3-10.2 {allrows - no args} {*}{ 1588 | -setup { 1589 | set stmt [::db prepare { 1590 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1591 | }] 1592 | } 1593 | -body { 1594 | $stmt allrows 1595 | } 1596 | -cleanup { 1597 | rename $stmt {} 1598 | } 1599 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1600 | } 1601 | 1602 | test tdbc::sqlite3-10.3 {allrows - no args} {*}{ 1603 | -body { 1604 | db allrows { 1605 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1606 | } 1607 | } 1608 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1609 | } 1610 | 1611 | test tdbc::sqlite3-10.4 {allrows --} {*}{ 1612 | -setup { 1613 | set stmt [::db prepare { 1614 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1615 | }] 1616 | set rs [$stmt execute] 1617 | } 1618 | -body { 1619 | $rs allrows -- 1620 | } 1621 | -cleanup { 1622 | rename $rs {} 1623 | rename $stmt {} 1624 | } 1625 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1626 | } 1627 | 1628 | test tdbc::sqlite3-10.5 {allrows --} {*}{ 1629 | -setup { 1630 | set stmt [::db prepare { 1631 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1632 | }] 1633 | } 1634 | -body { 1635 | $stmt allrows -- 1636 | } 1637 | -cleanup { 1638 | rename $stmt {} 1639 | } 1640 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1641 | } 1642 | 1643 | test tdbc::sqlite3-10.6 {allrows --} {*}{ 1644 | -body { 1645 | db allrows -- { 1646 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1647 | } 1648 | } 1649 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1650 | } 1651 | 1652 | test tdbc::sqlite3-10.7 {allrows -as lists} {*}{ 1653 | -setup { 1654 | set stmt [::db prepare { 1655 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1656 | }] 1657 | set rs [$stmt execute] 1658 | } 1659 | -body { 1660 | $rs allrows -as lists 1661 | } 1662 | -cleanup { 1663 | rename $rs {} 1664 | rename $stmt {} 1665 | } 1666 | -result {{4 barney} {5 betty} {6 bam-bam}} 1667 | } 1668 | 1669 | test tdbc::sqlite3-10.8 {allrows -as lists} {*}{ 1670 | -setup { 1671 | set stmt [::db prepare { 1672 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1673 | }] 1674 | } 1675 | -body { 1676 | $stmt allrows -as lists 1677 | } 1678 | -cleanup { 1679 | rename $stmt {} 1680 | } 1681 | -result {{4 barney} {5 betty} {6 bam-bam}} 1682 | } 1683 | 1684 | test tdbc::sqlite3-10.9 {allrows -as lists} {*}{ 1685 | -body { 1686 | db allrows -as lists { 1687 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1688 | } 1689 | } 1690 | -result {{4 barney} {5 betty} {6 bam-bam}} 1691 | } 1692 | 1693 | test tdbc::sqlite3-10.10 {allrows -as lists --} {*}{ 1694 | -setup { 1695 | set stmt [::db prepare { 1696 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1697 | }] 1698 | set rs [$stmt execute] 1699 | } 1700 | -body { 1701 | $rs allrows -as lists -- 1702 | } 1703 | -cleanup { 1704 | rename $rs {} 1705 | rename $stmt {} 1706 | } 1707 | -result {{4 barney} {5 betty} {6 bam-bam}} 1708 | } 1709 | 1710 | test tdbc::sqlite3-10.11 {allrows -as lists --} {*}{ 1711 | -setup { 1712 | set stmt [::db prepare { 1713 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1714 | }] 1715 | } 1716 | -body { 1717 | $stmt allrows -as lists -- 1718 | } 1719 | -cleanup { 1720 | rename $stmt {} 1721 | } 1722 | -result {{4 barney} {5 betty} {6 bam-bam}} 1723 | } 1724 | 1725 | test tdbc::sqlite3-10.12 {allrows -as lists --} {*}{ 1726 | -body { 1727 | db allrows -as lists -- { 1728 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1729 | } 1730 | } 1731 | -result {{4 barney} {5 betty} {6 bam-bam}} 1732 | } 1733 | 1734 | test tdbc::sqlite3-10.13 {allrows -as lists -columnsvar c} {*}{ 1735 | -setup { 1736 | set stmt [::db prepare { 1737 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1738 | }] 1739 | set rs [$stmt execute] 1740 | } 1741 | -body { 1742 | set result [$rs allrows -as lists -columnsvar c] 1743 | list $c $result 1744 | } 1745 | -cleanup { 1746 | rename $rs {} 1747 | rename $stmt {} 1748 | } 1749 | -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}} 1750 | } 1751 | 1752 | test tdbc::sqlite3-10.14 {allrows -as lists -columnsvar c} {*}{ 1753 | -setup { 1754 | set stmt [::db prepare { 1755 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1756 | }] 1757 | } 1758 | -body { 1759 | set result [$stmt allrows -as lists -columnsvar c] 1760 | list $c $result 1761 | } 1762 | -cleanup { 1763 | rename $stmt {} 1764 | } 1765 | -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}} 1766 | } 1767 | 1768 | test tdbc::sqlite3-10.15 {allrows -as lists -columnsvar c} {*}{ 1769 | -body { 1770 | set result [db allrows -as lists -columnsvar c { 1771 | SELECT idnum, name FROM people WHERE name LIKE 'b%' 1772 | }] 1773 | list $c $result 1774 | } 1775 | -result {{idnum name} {{4 barney} {5 betty} {6 bam-bam}}} 1776 | } 1777 | 1778 | test tdbc::sqlite3-10.16 {allrows - correct lexical scoping of variables} {*}{ 1779 | -setup { 1780 | set stmt [::db prepare { 1781 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1782 | }] 1783 | $stmt paramtype thePattern varchar 40 1784 | } 1785 | -body { 1786 | set thePattern b% 1787 | $stmt allrows 1788 | } 1789 | -cleanup { 1790 | $stmt close 1791 | } 1792 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1793 | } 1794 | 1795 | test tdbc::sqlite3-10.17 {allrows - parameters in a dictionary} {*}{ 1796 | -setup { 1797 | set stmt [::db prepare { 1798 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1799 | }] 1800 | $stmt paramtype thePattern varchar 40 1801 | } 1802 | -body { 1803 | $stmt allrows {thePattern b%} 1804 | } 1805 | -cleanup { 1806 | $stmt close 1807 | } 1808 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1809 | } 1810 | 1811 | test tdbc::sqlite3-10.18 {allrows - parameters in a dictionary} {*}{ 1812 | -body { 1813 | db allrows { 1814 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1815 | } {thePattern b%} 1816 | } 1817 | -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}} 1818 | } 1819 | 1820 | test tdbc::sqlite3-10.19 {allrows - variable not found} {*}{ 1821 | -setup { 1822 | catch {unset thePattern} 1823 | } 1824 | -body { 1825 | set thePattern(bogosity) {} 1826 | db allrows { 1827 | SELECT idnum, name FROM people WHERE name LIKE :thePattern 1828 | } 1829 | } 1830 | -cleanup { 1831 | unset thePattern 1832 | } 1833 | -result {} 1834 | } 1835 | 1836 | test tdbc::sqlite3-10.20 {allrows - too many args} {*}{ 1837 | -setup { 1838 | set stmt [::db prepare { 1839 | SELECT idnum, name FROM people 1840 | }] 1841 | } 1842 | -body { 1843 | $stmt allrows {} rubbish 1844 | } 1845 | -cleanup { 1846 | $stmt close 1847 | } 1848 | -returnCodes error 1849 | -result {wrong # args*} 1850 | -match glob 1851 | } 1852 | 1853 | test tdbc::sqlite3-10.21 {bad -as} {*}{ 1854 | -body { 1855 | db allrows -as trash { 1856 | SELECT idnum, name FROM people 1857 | } 1858 | } 1859 | -returnCodes error 1860 | -result {bad variable type "trash": must be lists or dicts} 1861 | } 1862 | 1863 | test tdbc::sqlite3-11.1 {update - no rows} {*}{ 1864 | -setup { 1865 | set stmt [::db prepare { 1866 | UPDATE people SET info = 1 WHERE idnum > 6 1867 | }] 1868 | set rs [$stmt execute] 1869 | } 1870 | -body { 1871 | $rs rowcount 1872 | } 1873 | -cleanup { 1874 | rename $rs {} 1875 | rename $stmt {} 1876 | } 1877 | -result 0 1878 | } 1879 | 1880 | test tdbc::sqlite3-11.2 {update - unique row} {*}{ 1881 | -setup { 1882 | set stmt [::db prepare { 1883 | UPDATE people SET info = 1 WHERE name = 'fred' 1884 | }] 1885 | } 1886 | -body { 1887 | set rs [$stmt execute] 1888 | $rs rowcount 1889 | } 1890 | -cleanup { 1891 | rename $rs {} 1892 | rename $stmt {} 1893 | } 1894 | -result 1 1895 | } 1896 | 1897 | test tdbc::sqlite3-11.3 {update - multiple rows} {*}{ 1898 | -setup { 1899 | set stmt [::db prepare { 1900 | UPDATE people SET info = 1 WHERE name LIKE 'b%' 1901 | }] 1902 | } 1903 | -body { 1904 | set rs [$stmt execute] 1905 | $rs rowcount 1906 | } 1907 | -cleanup { 1908 | rename $rs {} 1909 | rename $stmt {} 1910 | } 1911 | -result 3 1912 | } 1913 | 1914 | test tdbc::sqlite3-12.1 {delete - no rows} {*}{ 1915 | -setup { 1916 | set stmt [::db prepare { 1917 | DELETE FROM people WHERE name = 'nobody' 1918 | }] 1919 | } 1920 | -body { 1921 | set rs [$stmt execute] 1922 | $rs rowcount 1923 | } 1924 | -cleanup { 1925 | rename $rs {} 1926 | rename $stmt {} 1927 | } 1928 | -result 0 1929 | } 1930 | 1931 | test tdbc::sqlite3-12.2 {delete - unique row} {*}{ 1932 | -setup { 1933 | set stmt [::db prepare { 1934 | DELETE FROM people WHERE name = 'fred' 1935 | }] 1936 | } 1937 | -body { 1938 | set rs [$stmt execute] 1939 | $rs rowcount 1940 | } 1941 | -cleanup { 1942 | rename $rs {} 1943 | rename $stmt {} 1944 | } 1945 | -result 1 1946 | } 1947 | 1948 | test tdbc::sqlite3-12.3 {delete - multiple rows} {*}{ 1949 | -setup { 1950 | set stmt [::db prepare { 1951 | DELETE FROM people WHERE name LIKE 'b%' 1952 | }] 1953 | } 1954 | -body { 1955 | set rs [$stmt execute] 1956 | $rs rowcount 1957 | } 1958 | -cleanup { 1959 | rename $rs {} 1960 | rename $stmt {} 1961 | } 1962 | -result 3 1963 | } 1964 | 1965 | test tdbc::sqlite3-13.1 {resultsets - no results} {*}{ 1966 | -setup { 1967 | set stmt [::db prepare { 1968 | SELECT name FROM people WHERE idnum = $idnum 1969 | }] 1970 | } 1971 | -body { 1972 | list \ 1973 | [llength [$stmt resultsets]] \ 1974 | [llength [::db resultsets]] 1975 | } 1976 | -cleanup { 1977 | rename $stmt {} 1978 | } 1979 | -result {0 0} 1980 | } 1981 | 1982 | test tdbc::sqlite3-13.2 {resultsets - various statements and results} {*}{ 1983 | -setup { 1984 | for {set i 0} {$i < 6} {incr i} { 1985 | set stmts($i) [::db prepare { 1986 | SELECT name FROM people WHERE idnum = :idnum 1987 | }] 1988 | $stmts($i) paramtype idnum integer 1989 | for {set j 0} {$j < $i} {incr j} { 1990 | set resultsets($i,$j) [$stmts($i) execute [list idnum $j]] 1991 | } 1992 | for {set j 1} {$j < $i} {incr j 2} { 1993 | $resultsets($i,$j) close 1994 | unset resultsets($i,$j) 1995 | } 1996 | } 1997 | } 1998 | -body { 1999 | set x [list [llength [::db resultsets]]] 2000 | for {set i 0} {$i < 6} {incr i} { 2001 | lappend x [llength [$stmts($i) resultsets]] 2002 | } 2003 | set x 2004 | } 2005 | -cleanup { 2006 | for {set i 0} {$i < 6} {incr i} { 2007 | $stmts($i) close 2008 | } 2009 | } 2010 | -result {9 0 1 1 2 2 3} 2011 | } 2012 | 2013 | # reset the database again 2014 | 2015 | catch { 2016 | db allrows {DELETE FROM people} 2017 | set stmt [db prepare { 2018 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 2019 | }] 2020 | $stmt paramtype idnum integer 2021 | $stmt paramtype name varchar 40 2022 | set idnum 1 2023 | foreach name {fred wilma pebbles barney betty bam-bam} { 2024 | set rs [$stmt execute] 2025 | rename $rs {} 2026 | incr idnum 2027 | } 2028 | rename $stmt {} 2029 | } 2030 | 2031 | test tdbc::sqlite3-13.3 {duplicate column names} {*}{ 2032 | -constraints knownBug 2033 | -body { 2034 | ::db allrows -as dicts -- { 2035 | select a.name, b.name, c.name from people a, people b, people c 2036 | where a.idnum = 1 2037 | and b.idnum = a.idnum + 1 2038 | and c.idnum = a.idnum + 2 2039 | } 2040 | } 2041 | -result {{name fred name#2 wilma name#3 pebbles}} 2042 | } 2043 | 2044 | test tdbc::sqlite3-13.4 {duplicate column names} {*}{ 2045 | -constraints knownBug 2046 | -body { 2047 | ::db allrows -as dicts -- { 2048 | select a.name, b.name, c.name as "name#2" 2049 | from people a, people b, people c 2050 | where a.idnum = 1 2051 | and b.idnum = a.idnum + 1 2052 | and c.idnum = a.idnum + 2 2053 | } 2054 | } 2055 | -result {{name fred name#2 wilma name#2#1 pebbles}} 2056 | } 2057 | 2058 | test tdbc::sqlite3-13.5 {duplicate column names} {*}{ 2059 | -constraints knownBug 2060 | -body { 2061 | ::db allrows -as dicts -- { 2062 | select a.name, b.name as "name#2", c.name 2063 | from people a, people b, people c 2064 | where a.idnum = 1 2065 | and b.idnum = a.idnum + 1 2066 | and c.idnum = a.idnum + 2 2067 | } 2068 | } 2069 | -result {{name fred name#2 wilma name#2#1 pebbles}} 2070 | } 2071 | 2072 | #------------------------------------------------------------------------------- 2073 | # 2074 | # next tests require a fresh database connection. Close the existing one down 2075 | 2076 | catch { 2077 | set stmt [db prepare { 2078 | DELETE FROM people 2079 | }] 2080 | $stmt execute 2081 | } 2082 | catch { 2083 | rename ::db {} 2084 | } 2085 | 2086 | tdbc::sqlite3::connection create ::db $::testDBName 2087 | catch { 2088 | set stmt [db prepare { 2089 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 2090 | }] 2091 | $stmt paramtype idnum integer 2092 | $stmt paramtype name varchar 40 2093 | set idnum 1 2094 | foreach name {fred wilma pebbles barney betty bam-bam} { 2095 | set rs [$stmt execute] 2096 | rename $rs {} 2097 | incr idnum 2098 | } 2099 | rename $stmt {} 2100 | } 2101 | 2102 | test tdbc::sqlite3-14.1 {begin transaction - wrong # args} {*}{ 2103 | -body { 2104 | ::db begintransaction junk 2105 | } 2106 | -returnCodes error 2107 | -match glob 2108 | -result {wrong # args*} 2109 | } 2110 | 2111 | test tdbc::sqlite3-14.2 {commit - wrong # args} {*}{ 2112 | -body { 2113 | ::db commit junk 2114 | } 2115 | -returnCodes error 2116 | -match glob 2117 | -result {wrong # args*} 2118 | } 2119 | 2120 | test tdbc::sqlite3-14.3 {rollback - wrong # args} {*}{ 2121 | -body { 2122 | ::db rollback junk 2123 | } 2124 | -returnCodes error 2125 | -match glob 2126 | -result {wrong # args*} 2127 | } 2128 | 2129 | test tdbc::sqlite3-14.4 {commit - not in transaction} {*}{ 2130 | -body { 2131 | list [catch {::db commit} result] $result 2132 | } 2133 | -result {1 {cannot commit - no transaction is active}} 2134 | } 2135 | 2136 | test tdbc::sqlite3-14.5 {rollback - not in transaction} {*}{ 2137 | -body { 2138 | list [catch {::db rollback} result] $result 2139 | } 2140 | -match glob 2141 | -result {1 {cannot rollback - no transaction is active}} 2142 | } 2143 | 2144 | test tdbc::sqlite3-14.6 {empty transaction} {*}{ 2145 | -body { 2146 | ::db begintransaction 2147 | ::db commit 2148 | } 2149 | -result {} 2150 | } 2151 | 2152 | test tdbc::sqlite3-14.7 {empty rolled-back transaction} {*}{ 2153 | -body { 2154 | ::db begintransaction 2155 | ::db rollback 2156 | } 2157 | -result {} 2158 | } 2159 | 2160 | test tdbc::sqlite3-14.8 {rollback does not change database} {*}{ 2161 | -body { 2162 | ::db begintransaction 2163 | set stmt [::db prepare {DELETE FROM people WHERE name = 'fred'}] 2164 | set rs [$stmt execute] 2165 | while {[$rs nextrow trash]} {} 2166 | rename $rs {} 2167 | rename $stmt {} 2168 | ::db rollback 2169 | set stmt [::db prepare {SELECT idnum FROM people WHERE name = 'fred'}] 2170 | set id {changes still visible after rollback} 2171 | set rs [$stmt execute] 2172 | while {[$rs nextrow -as lists row]} { 2173 | set id [lindex $row 0] 2174 | } 2175 | rename $rs {} 2176 | rename $stmt {} 2177 | set id 2178 | } 2179 | -result 1 2180 | } 2181 | 2182 | test tdbc::sqlite3-14.9 {commit does change database} {*}{ 2183 | -setup { 2184 | set stmt1 [db prepare { 2185 | INSERT INTO people(idnum, name, info) 2186 | VALUES(7, 'mr. gravel', 0) 2187 | }] 2188 | set stmt2 [db prepare { 2189 | SELECT idnum FROM people WHERE name = 'mr. gravel' 2190 | }] 2191 | } 2192 | -body { 2193 | ::db begintransaction 2194 | set rs [$stmt1 execute] 2195 | rename $rs {} 2196 | ::db commit 2197 | set rs [$stmt2 execute] 2198 | while {[$rs nextrow -as lists row]} { 2199 | set id [lindex $row 0] 2200 | } 2201 | rename $rs {} 2202 | set id 2203 | } 2204 | -cleanup { 2205 | rename $stmt1 {} 2206 | rename $stmt2 {} 2207 | } 2208 | -result 7 2209 | } 2210 | 2211 | test tdbc::sqlite3-14.10 {nested transactions} {*}{ 2212 | -body { 2213 | ::db begintransaction 2214 | list [catch {::db begintransaction} result] $result 2215 | } 2216 | -cleanup { 2217 | catch {::db rollback} 2218 | } 2219 | -match glob 2220 | -result {1 {cannot start a transaction within a transaction}} 2221 | } 2222 | 2223 | #------------------------------------------------------------------------------ 2224 | # 2225 | # Clean up database again for the next round. 2226 | 2227 | catch { 2228 | set stmt [db prepare { 2229 | DELETE FROM people 2230 | }] 2231 | $stmt execute 2232 | } 2233 | catch { 2234 | rename ::db {} 2235 | } 2236 | 2237 | tdbc::sqlite3::connection create ::db $::testDBName 2238 | catch { 2239 | set stmt [db prepare { 2240 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 2241 | }] 2242 | $stmt paramtype idnum integer 2243 | $stmt paramtype name varchar 40 2244 | set idnum 1 2245 | foreach name {fred wilma pebbles barney betty bam-bam} { 2246 | set rs [$stmt execute] 2247 | rename $rs {} 2248 | incr idnum 2249 | } 2250 | rename $stmt {} 2251 | } 2252 | 2253 | test tdbc::sqlite3-15.1 {successful (empty) transaction} {*}{ 2254 | -body { 2255 | db transaction { 2256 | concat ok 2257 | } 2258 | } 2259 | -result ok 2260 | } 2261 | 2262 | test tdbc::sqlite3-15.2 {failing transaction does not get committed} {*}{ 2263 | -setup { 2264 | set stmt1 [db prepare { 2265 | DELETE FROM people WHERE name = 'fred' 2266 | }] 2267 | set stmt2 [db prepare { 2268 | SELECT idnum FROM people WHERE name = 'fred' 2269 | }] 2270 | } 2271 | -body { 2272 | catch { 2273 | ::db transaction { 2274 | set rs [$stmt1 execute] 2275 | rename $rs {} 2276 | error "abort the transaction" 2277 | } 2278 | } result 2279 | set id {failed transaction got committed} 2280 | set rs [$stmt2 execute] 2281 | while {[$rs nextrow -as lists row]} { 2282 | set id [lindex $row 0] 2283 | } 2284 | rename $rs {} 2285 | list $result $id 2286 | } 2287 | -cleanup { 2288 | rename $stmt1 {} 2289 | rename $stmt2 {} 2290 | } 2291 | -result {{abort the transaction} 1} 2292 | } 2293 | 2294 | test tdbc::sqlite3-15.3 {successful transaction gets committed} {*}{ 2295 | -setup { 2296 | set stmt1 [db prepare { 2297 | INSERT INTO people(idnum, name, info) 2298 | VALUES(7, 'mr. gravel', 0) 2299 | }] 2300 | set stmt2 [db prepare { 2301 | SELECT idnum FROM people WHERE name = 'mr. gravel' 2302 | }] 2303 | } 2304 | -body { 2305 | ::db transaction { 2306 | set rs [$stmt1 execute] 2307 | rename $rs {} 2308 | } 2309 | set rs [$stmt2 execute] 2310 | while {[$rs nextrow -as lists row]} { 2311 | set id [lindex $row 0] 2312 | } 2313 | rename $rs {} 2314 | set id 2315 | } 2316 | -cleanup { 2317 | rename $stmt1 {} 2318 | rename $stmt2 {} 2319 | } 2320 | -result 7 2321 | } 2322 | 2323 | test tdbc::sqlite3-15.4 {break out of transaction commits it} {*}{ 2324 | -setup { 2325 | set stmt1 [db prepare { 2326 | INSERT INTO people(idnum, name, info) 2327 | VALUES(8, 'gary granite', 0) 2328 | }] 2329 | set stmt2 [db prepare { 2330 | SELECT idnum FROM people WHERE name = 'gary granite' 2331 | }] 2332 | } 2333 | -body { 2334 | while {1} { 2335 | ::db transaction { 2336 | set rs [$stmt1 execute] 2337 | rename $rs {} 2338 | break 2339 | } 2340 | } 2341 | set rs [$stmt2 execute] 2342 | while {[$rs nextrow -as lists row]} { 2343 | set id [lindex $row 0] 2344 | } 2345 | rename $rs {} 2346 | set id 2347 | } 2348 | -cleanup { 2349 | rename $stmt1 {} 2350 | rename $stmt2 {} 2351 | } 2352 | -result 8 2353 | } 2354 | 2355 | test tdbc::sqlite3-15.5 {continue in transaction commits it} {*}{ 2356 | -setup { 2357 | set stmt1 [db prepare { 2358 | INSERT INTO people(idnum, name, info) 2359 | VALUES(9, 'hud rockstone', 0) 2360 | }] 2361 | set stmt2 [db prepare { 2362 | SELECT idnum FROM people WHERE name = 'hud rockstone' 2363 | }] 2364 | } 2365 | -body { 2366 | for {set i 0} {$i < 1} {incr i} { 2367 | ::db transaction { 2368 | set rs [$stmt1 execute] 2369 | rename $rs {} 2370 | continue 2371 | } 2372 | } 2373 | set rs [$stmt2 execute] 2374 | while {[$rs nextrow -as lists row]} { 2375 | set id [lindex $row 0] 2376 | } 2377 | rename $rs {} 2378 | set id 2379 | } 2380 | -cleanup { 2381 | rename $stmt1 {} 2382 | rename $stmt2 {} 2383 | } 2384 | -result 9 2385 | } 2386 | 2387 | test tdbc::sqlite3-15.6 {return in transaction commits it} {*}{ 2388 | -setup { 2389 | set stmt1 [db prepare { 2390 | INSERT INTO people(idnum, name, info) 2391 | VALUES(10, 'nelson stoneyfeller', 0) 2392 | }] 2393 | set stmt2 [db prepare { 2394 | SELECT idnum FROM people WHERE name = 'nelson stoneyfeller' 2395 | }] 2396 | proc tdbc::sqlite3-15.6 {stmt1} { 2397 | ::db transaction { 2398 | set rs [$stmt1 execute] 2399 | rename $rs {} 2400 | return 2401 | } 2402 | } 2403 | } 2404 | -body { 2405 | tdbc::sqlite3-15.6 $stmt1 2406 | set rs [$stmt2 execute] 2407 | while {[$rs nextrow -as lists row]} { 2408 | set id [lindex $row 0] 2409 | } 2410 | rename $rs {} 2411 | set id 2412 | } 2413 | -cleanup { 2414 | rename $stmt1 {} 2415 | rename $stmt2 {} 2416 | rename tdbc::sqlite3-15.6 {} 2417 | } 2418 | -result 10 2419 | } 2420 | 2421 | test tdbc::sqlite3-16.1 {database tables, wrong # args} { 2422 | -body { 2423 | set dict [::db tables % rubbish] 2424 | } 2425 | -returnCodes error 2426 | -match glob 2427 | -result {wrong # args*} 2428 | } 2429 | 2430 | test tdbc::sqlite3-16.2 {database tables - empty set} { 2431 | -body { 2432 | ::db tables q% 2433 | } 2434 | -result {} 2435 | } 2436 | 2437 | test tdbc::sqlite3-16.3 {enumerate database tables} {*}{ 2438 | -body { 2439 | set dict [::db tables] 2440 | list [dict exists $dict people] [dict exists $dict property] 2441 | } 2442 | -result {1 0} 2443 | } 2444 | 2445 | test tdbc::sqlite3-16.4 {enumerate database tables} {*}{ 2446 | -body { 2447 | set dict [::db tables p%] 2448 | list [dict exists $dict people] [dict exists $dict property] 2449 | } 2450 | -result {1 0} 2451 | } 2452 | 2453 | test tdbc::sqlite3-17.1 {database columns - wrong # args} {*}{ 2454 | -body { 2455 | set dict [::db columns people % rubbish] 2456 | } 2457 | -returnCodes error 2458 | -match glob 2459 | -result {wrong # args*} 2460 | } 2461 | 2462 | test tdbc::sqlite3-17.2 {database columns - no such table} {*}{ 2463 | -body { 2464 | ::db columns rubbish 2465 | } 2466 | -result {} 2467 | } 2468 | 2469 | test tdbc::sqlite3-17.3 {database columns - no match pattern} {*}{ 2470 | -body { 2471 | set result {} 2472 | dict for {colname attrs} [::db columns people] { 2473 | lappend result $colname \ 2474 | [dict get $attrs type] \ 2475 | [expr {[dict exists $attrs precision] ? 2476 | [dict get $attrs precision] : {NULL}}] \ 2477 | [expr {[dict exists $attrs scale] ? 2478 | [dict get $attrs scale] : {NULL}}] \ 2479 | [dict get $attrs nullable] 2480 | } 2481 | set result 2482 | } 2483 | -match glob 2484 | -result {idnum integer * 0 1 name varchar 40 * info integer * 0 1} 2485 | } 2486 | 2487 | # sqlite driver appears not to implement pattern matching for SQLGetColumns 2488 | test tdbc::sqlite3-17.4 {database columns - match pattern} {*}{ 2489 | -body { 2490 | set result {} 2491 | dict for {colname attrs} [::db columns people i%] { 2492 | lappend result $colname \ 2493 | [dict get $attrs type] \ 2494 | [expr {[dict exists $attrs precision] ? 2495 | [dict get $attrs precision] : {NULL}}] \ 2496 | [expr {[dict exists $attrs scale] ? 2497 | [dict get $attrs scale] : {NULL}}] \ 2498 | [dict get $attrs nullable] 2499 | } 2500 | set result 2501 | } 2502 | -result {idnum integer 0 0 1 info integer 0 0 1} 2503 | } 2504 | 2505 | test tdbc::sqlite3-18.1 {$statement params - excess arg} {*}{ 2506 | -setup { 2507 | set s [::db prepare { 2508 | SELECT name FROM people 2509 | WHERE name LIKE :pattern 2510 | AND idnum >= :minid 2511 | }] 2512 | $s paramtype minid numeric 10 0 2513 | $s paramtype pattern varchar 40 2514 | } 2515 | -body { 2516 | $s params excess 2517 | } 2518 | -cleanup { 2519 | rename $s {} 2520 | } 2521 | -returnCodes error 2522 | -match glob 2523 | -result {wrong # args*} 2524 | } 2525 | 2526 | test tdbc::sqlite3-18.2 {$statement params - no params} {*}{ 2527 | -setup { 2528 | set s [::db prepare { 2529 | SELECT name FROM people 2530 | }] 2531 | } 2532 | -body { 2533 | $s params 2534 | } 2535 | -cleanup { 2536 | rename $s {} 2537 | } 2538 | -result {} 2539 | } 2540 | 2541 | test tdbc::sqlite3-18.3 {$statement params - excess arg} {*}{ 2542 | -setup { 2543 | set s [::db prepare { 2544 | SELECT name FROM people 2545 | WHERE name LIKE :pattern 2546 | AND idnum >= :minid 2547 | }] 2548 | $s paramtype minid numeric 10 0 2549 | $s paramtype pattern varchar 40 2550 | } 2551 | -body { 2552 | set d [$s params] 2553 | list \ 2554 | [dict get $d minid direction] \ 2555 | [dict get $d minid type] \ 2556 | [dict get $d minid precision] \ 2557 | [dict get $d minid scale] \ 2558 | [dict get $d pattern direction] \ 2559 | [dict get $d pattern type] \ 2560 | [dict get $d pattern precision] 2561 | } 2562 | -cleanup { 2563 | rename $s {} 2564 | } 2565 | -result {in Tcl_Obj 0 0 in Tcl_Obj 0} 2566 | } 2567 | 2568 | test tdbc::sqlite3-19.1 {$connection configure - no args} \ 2569 | -body { 2570 | ::db configure 2571 | } \ 2572 | -match glob \ 2573 | -result [list -encoding utf-8 \ 2574 | -isolation serializable \ 2575 | -readonly 0 \ 2576 | -timeout 0] 2577 | 2578 | test tdbc::sqlite3-19.2 {$connection configure - unknown arg} {*}{ 2579 | -body { 2580 | ::db configure -junk 2581 | } 2582 | -returnCodes error 2583 | -match glob 2584 | -result "bad option *" 2585 | } 2586 | 2587 | test tdbc::sqlite3-19.4 {$connection configure - set unknown arg} {*}{ 2588 | -body { 2589 | ::db configure -junk morejunk 2590 | } 2591 | -returnCodes error 2592 | -match glob 2593 | -result "bad option *" 2594 | } 2595 | 2596 | test tdbc::sqlite3-19.6 {$connection configure - wrong # args} {*}{ 2597 | -body { 2598 | ::db configure -parent . -junk 2599 | } 2600 | -returnCodes error 2601 | -match glob 2602 | -result "wrong # args*" 2603 | } 2604 | 2605 | test tdbc::sqlite3-19.7 {$connection configure - -encoding} {*}{ 2606 | -body { 2607 | ::db configure -encoding junk 2608 | } 2609 | -returnCodes error 2610 | -match glob 2611 | -result {-encoding not supported*} 2612 | } 2613 | 2614 | test tdbc::sqlite3-19.9 {$connection configure - -encoding} \ 2615 | -body { 2616 | list [::db configure -encoding utf-8] \ 2617 | [::db configure -encoding] 2618 | } \ 2619 | -result [list {} utf-8] 2620 | 2621 | 2622 | test tdbc::sqlite3-19.10 {$connection configure - -isolation} {*}{ 2623 | -body { 2624 | ::db configure -isolation junk 2625 | } 2626 | -returnCodes error 2627 | -match glob 2628 | -result {bad isolation level "junk"*} 2629 | } 2630 | 2631 | test tdbc::sqlite3-19.11 {$connection configure - -isolation} {*}{ 2632 | -body { 2633 | list [::db configure -isolation readuncommitted] \ 2634 | [::db configure -isolation] \ 2635 | [::db configure -isolation readcommitted] \ 2636 | [::db configure -isolation] 2637 | } 2638 | -result {{} readuncommitted {} serializable} 2639 | } 2640 | 2641 | test tdbc::sqlite3-19.12 {$connection configure - -readonly} {*}{ 2642 | -body { 2643 | ::db configure -readonly junk 2644 | } 2645 | -returnCodes error 2646 | -result {expected boolean value but got "junk"} 2647 | } 2648 | 2649 | test tdbc::sqlite3-19.14 {$connection configure - -timeout} {*}{ 2650 | -body { 2651 | ::db configure -timeout junk 2652 | } 2653 | -returnCodes error 2654 | -result {expected integer but got "junk"} 2655 | } 2656 | 2657 | test tdbc::sqlite3-19.15 {$connection configure - -timeout} {*}{ 2658 | -body { 2659 | catch {::db configure -timeout 5000} result 2660 | list [::db configure -timeout 0] [::db configure -timeout] 2661 | } 2662 | -result {{} 0} 2663 | } 2664 | 2665 | # Information schema tests require additional tables in the database. 2666 | # Create them now. 2667 | 2668 | catch {::db allrows {DROP TABLE d}} 2669 | catch {::db allrows {DROP TABLE c}} 2670 | catch {::db allrows {DROP TABLE b}} 2671 | catch {::db allrows {DROP TABLE a}} 2672 | 2673 | 2674 | ::db allrows { 2675 | CREATE TABLE a ( 2676 | k1 INTEGER, 2677 | CONSTRAINT pk_a PRIMARY KEY(k1) 2678 | ) 2679 | } 2680 | 2681 | ::db allrows { 2682 | CREATE TABLE b ( 2683 | k1 INTEGER, 2684 | k2 INTEGER, 2685 | CONSTRAINT pk_b PRIMARY KEY(k1, k2), 2686 | CONSTRAINT fk_b1 FOREIGN KEY (k1) REFERENCES a(k1), 2687 | CONSTRAINT fk_b2 FOREIGN KEY (k2) REFERENCES a(k1) 2688 | ) 2689 | } 2690 | 2691 | ::db allrows { 2692 | CREATE TABLE c ( 2693 | p1 INTEGER, 2694 | p2 INTEGER, 2695 | CONSTRAINT pk_c PRIMARY KEY(p1, p2), 2696 | CONSTRAINT fk_c1 FOREIGN KEY (p1) REFERENCES a(k1), 2697 | CONSTRAINT fk_c2 FOREIGN KEY (p2) REFERENCES a(k1), 2698 | CONSTRAINT fk_cpair FOREIGN KEY (p1,p2) REFERENCES b(k2,k1) 2699 | ) 2700 | } 2701 | 2702 | ::db allrows { 2703 | CREATE TABLE d ( 2704 | dtext VARCHAR(40) 2705 | ) 2706 | } 2707 | 2708 | test tdbc::sqlite3-23.1 {Primary keys - no arg} {*}{ 2709 | -body { 2710 | ::db primarykeys 2711 | } 2712 | -returnCodes error 2713 | -match glob 2714 | -result {wrong # args*} 2715 | } 2716 | test tdbc::sqlite3-23.2 {Primary keys - no primary key} {*}{ 2717 | -body { 2718 | ::db primarykeys d 2719 | } 2720 | -result {} 2721 | } 2722 | test tdbc::sqlite3-23.3 {Primary keys - simple primary key} {*}{ 2723 | -body { 2724 | set result {} 2725 | foreach row [::db primarykeys a] { 2726 | lappend result [dict get $row columnName] [dict get $row ordinalPosition] 2727 | } 2728 | set result 2729 | } 2730 | -result {k1 1} 2731 | } 2732 | test tdbc::sqlite3-23.4 {Primary keys - compound primary key} {*}{ 2733 | -body { 2734 | set result {} 2735 | foreach row [::db primarykeys b] { 2736 | lappend result [dict get $row columnName] [dict get $row ordinalPosition] 2737 | } 2738 | set result 2739 | } 2740 | -result {k1 1 k2 2} 2741 | } 2742 | 2743 | test tdbc::sqlite3-24.1 {Foreign keys - wrong # args} {*}{ 2744 | -body { 2745 | ::db foreignkeys -wrong 2746 | } 2747 | -returnCodes error 2748 | -match glob 2749 | -result {wrong # args*} 2750 | } 2751 | 2752 | test tdbc::sqlite3-24.2 {Foreign keys - bad arg} {*}{ 2753 | -body { 2754 | ::db foreignkeys -primary a -rubbish b 2755 | } 2756 | -returnCodes error 2757 | -match glob 2758 | -result {bad option "-rubbish"*} 2759 | } 2760 | 2761 | test tdbc::sqlite3-24.3 {Foreign keys - redundant arg} {*}{ 2762 | -body { 2763 | ::db foreignkeys -primary a -primary b 2764 | } 2765 | -returnCodes error 2766 | -match glob 2767 | -result {duplicate option "primary"*} 2768 | } 2769 | 2770 | test tdbc::sqlite3-24.4 {Foreign keys - list all} \ 2771 | -body { 2772 | set result {} 2773 | set wanted {a {} b {} c {} d {} people {}} 2774 | foreach row [::db foreignkeys] { 2775 | if {[dict exists $wanted [dict get $row foreignTable]]} { 2776 | dict set result [dict get $row foreignConstraintName] \ 2777 | [dict get $row ordinalPosition] \ 2778 | [list [dict get $row foreignTable] \ 2779 | [dict get $row foreignColumn] \ 2780 | [dict get $row primaryTable] \ 2781 | [dict get $row primaryColumn]] 2782 | } 2783 | } 2784 | lsort [dict values $result] 2785 | } \ 2786 | -result [list \ 2787 | {1 {b k1 a k1}} \ 2788 | {1 {b k2 a k1}} \ 2789 | {1 {c p1 a k1}} \ 2790 | {1 {c p1 b k2} 2 {c p2 b k1}} \ 2791 | {1 {c p2 a k1}} \ 2792 | ] 2793 | 2794 | 2795 | test tdbc::sqlite3-24.5 {Foreign keys - -foreign} \ 2796 | -body { 2797 | set result {} 2798 | set wanted {a {} b {} c {} d {} people {}} 2799 | foreach row [::db foreignkeys -foreign c] { 2800 | if {[dict exists $wanted [dict get $row foreignTable]]} { 2801 | dict set result [dict get $row foreignConstraintName] \ 2802 | [dict get $row ordinalPosition] \ 2803 | [list [dict get $row foreignTable] \ 2804 | [dict get $row foreignColumn] \ 2805 | [dict get $row primaryTable] \ 2806 | [dict get $row primaryColumn]] 2807 | } 2808 | } 2809 | lsort [dict values $result] 2810 | } \ 2811 | -result [list \ 2812 | {1 {c p1 a k1}} \ 2813 | {1 {c p1 b k2} 2 {c p2 b k1}} \ 2814 | {1 {c p2 a k1}} \ 2815 | ] 2816 | 2817 | test tdbc::sqlite3-24.6 {Foreign keys - -primary} \ 2818 | -body { 2819 | set result {} 2820 | set wanted {a {} b {} c {} d {} people {}} 2821 | foreach row [::db foreignkeys -primary a] { 2822 | if {[dict exists $wanted [dict get $row foreignTable]]} { 2823 | dict set result [dict get $row foreignConstraintName] \ 2824 | [dict get $row ordinalPosition] \ 2825 | [list [dict get $row foreignTable] \ 2826 | [dict get $row foreignColumn] \ 2827 | [dict get $row primaryTable] \ 2828 | [dict get $row primaryColumn]] 2829 | } 2830 | } 2831 | lsort [dict values $result] 2832 | } \ 2833 | -result [list \ 2834 | {1 {b k1 a k1}} \ 2835 | {1 {b k2 a k1}} \ 2836 | {1 {c p1 a k1}} \ 2837 | {1 {c p2 a k1}}] 2838 | 2839 | test tdbc::sqlite3-24.7 {Foreign keys - -foreign and -primary} \ 2840 | -body { 2841 | set result {} 2842 | set wanted {a {} b {} c {} d {} people {}} 2843 | foreach row [::db foreignkeys -foreign c -primary b] { 2844 | if {[dict exists $wanted [dict get $row foreignTable]]} { 2845 | dict set result [dict get $row foreignConstraintName] \ 2846 | [dict get $row ordinalPosition] \ 2847 | [list [dict get $row foreignTable] \ 2848 | [dict get $row foreignColumn] \ 2849 | [dict get $row primaryTable] \ 2850 | [dict get $row primaryColumn]] 2851 | } 2852 | } 2853 | lsort [dict values $result] 2854 | } \ 2855 | -result [list {1 {c p1 b k2} 2 {c p2 b k1}}] 2856 | 2857 | test tdbc::sqlite3-30.0 {Multiple result sets} {*}{ 2858 | -body { 2859 | set stmt [::db prepare { }] 2860 | catch { 2861 | set resultset [$stmt execute {}] 2862 | catch { 2863 | set rowsets {} 2864 | while {1} { 2865 | set rows {} 2866 | while {[$resultset nextrow row]} { 2867 | lappend rows $row 2868 | } 2869 | lappend rowsets $rows 2870 | if {[$resultset nextresults] == 0} break 2871 | } 2872 | set rowsets 2873 | } results 2874 | rename $resultset {} 2875 | set results 2876 | } results 2877 | rename $stmt {} 2878 | set results 2879 | } 2880 | -result {{}} 2881 | } 2882 | 2883 | test tdbc::sqlite3-30.1 {Multiple result sets - but in reality only one} {*}{ 2884 | -setup { 2885 | ::db allrows {delete from people} 2886 | set stmt [db prepare { 2887 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 2888 | }] 2889 | $stmt paramtype idnum integer 2890 | $stmt paramtype name varchar 40 2891 | set idnum 1 2892 | foreach name {fred wilma pebbles barney betty bam-bam} { 2893 | set rs [$stmt execute] 2894 | rename $rs {} 2895 | incr idnum 2896 | } 2897 | rename $stmt {} 2898 | } 2899 | -body { 2900 | set stmt [::db prepare { 2901 | select idnum, name from people where name = :a; 2902 | }] 2903 | catch { 2904 | set resultset [$stmt execute {a wilma}] 2905 | catch { 2906 | set rowsets {} 2907 | while {1} { 2908 | set rows {} 2909 | while {[$resultset nextrow row]} { 2910 | lappend rows $row 2911 | } 2912 | lappend rowsets $rows 2913 | if {[$resultset nextresults] == 0} break 2914 | } 2915 | set rowsets 2916 | } results 2917 | rename $resultset {} 2918 | set results 2919 | } results 2920 | rename $stmt {} 2921 | set results 2922 | } 2923 | -result {{{idnum 2 name wilma}}} 2924 | } 2925 | 2926 | test tdbc::sqlite3-30.2 {Multiple result sets - actually multiple} {*}{ 2927 | -setup { 2928 | ::db allrows {delete from people} 2929 | set stmt [db prepare { 2930 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 2931 | }] 2932 | $stmt paramtype idnum integer 2933 | $stmt paramtype name varchar 40 2934 | set idnum 1 2935 | foreach name {fred wilma pebbles barney betty bam-bam} { 2936 | set rs [$stmt execute] 2937 | rename $rs {} 2938 | incr idnum 2939 | } 2940 | rename $stmt {} 2941 | } 2942 | -body { 2943 | set stmt [::db prepare { 2944 | select idnum, name from people where name = :a; 2945 | select idnum, name, 1 as something from people where name = :b; 2946 | }] 2947 | catch { 2948 | set resultset [$stmt execute {a wilma b pebbles}] 2949 | catch { 2950 | set rowsets {} 2951 | while {1} { 2952 | set rows {} 2953 | while {[$resultset nextrow row]} { 2954 | lappend rows $row 2955 | } 2956 | lappend rowsets $rows 2957 | if {[$resultset nextresults] == 0} break 2958 | } 2959 | set rowsets 2960 | } results 2961 | rename $resultset {} 2962 | set results 2963 | } results 2964 | rename $stmt {} 2965 | set results 2966 | } 2967 | -result {{{idnum 2 name wilma}} {{idnum 3 name pebbles something 1}}} 2968 | } 2969 | 2970 | test tdbc::sqlite3-30.3 {Multiple result sets - try to read past end} {*}{ 2971 | -setup { 2972 | ::db allrows {delete from people} 2973 | set stmt [db prepare { 2974 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 2975 | }] 2976 | $stmt paramtype idnum integer 2977 | $stmt paramtype name varchar 40 2978 | set idnum 1 2979 | foreach name {fred wilma pebbles barney betty bam-bam} { 2980 | set rs [$stmt execute] 2981 | rename $rs {} 2982 | incr idnum 2983 | } 2984 | rename $stmt {} 2985 | } 2986 | -body { 2987 | set stmt [::db prepare { 2988 | select idnum, name from people where name = :a; 2989 | }] 2990 | catch { 2991 | set resultset [$stmt execute {a wilma}] 2992 | catch { 2993 | set rowsets {} 2994 | while {1} { 2995 | set rows {} 2996 | while {[$resultset nextrow row]} { 2997 | lappend rows $row 2998 | } 2999 | lappend rowsets $rows 3000 | if {[$resultset nextresults] == 0} break 3001 | } 3002 | lappend rowsets [catch {$resultset nextresults} msg] $msg 3003 | lappend rowsets [catch {$resultset nextrow foo} msg] $::errorCode 3004 | set rowsets 3005 | } results 3006 | rename $resultset {} 3007 | set results 3008 | } results 3009 | rename $stmt {} 3010 | set results 3011 | } 3012 | -match glob 3013 | -result {{{idnum 2 name wilma}} 0 0 1 {TDBC GENERAL_ERROR HY010 *}} 3014 | } 3015 | 3016 | test tdbc::sqlite3-30.4 {Multiple result sets - foreach} {*}{ 3017 | -setup { 3018 | ::db allrows {delete from people} 3019 | set stmt [db prepare { 3020 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 3021 | }] 3022 | $stmt paramtype idnum integer 3023 | $stmt paramtype name varchar 40 3024 | set idnum 1 3025 | foreach name {fred wilma pebbles barney betty bam-bam} { 3026 | set rs [$stmt execute] 3027 | rename $rs {} 3028 | incr idnum 3029 | } 3030 | rename $stmt {} 3031 | } 3032 | -body { 3033 | set rows {} 3034 | ::db foreach -columnsvar c -- row { 3035 | select idnum, name from people where name = :a; 3036 | select idnum, name, 1 as something from people where name = :b; 3037 | } {a wilma b pebbles} { 3038 | lappend rows $c $row 3039 | } 3040 | set rows 3041 | } 3042 | -result {{idnum name} {idnum 2 name wilma} {idnum name something} {idnum 3 name pebbles something 1}} 3043 | } 3044 | 3045 | test tdbc::sqlite3-30.5 {Multiple result sets - allrows} {*}{ 3046 | -setup { 3047 | ::db allrows {delete from people} 3048 | set stmt [db prepare { 3049 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 3050 | }] 3051 | $stmt paramtype idnum integer 3052 | $stmt paramtype name varchar 40 3053 | set idnum 1 3054 | foreach name {fred wilma pebbles barney betty bam-bam} { 3055 | set rs [$stmt execute] 3056 | rename $rs {} 3057 | incr idnum 3058 | } 3059 | rename $stmt {} 3060 | } 3061 | -body { 3062 | ::db allrows -as dicts { 3063 | select idnum, name from people where name = :a; 3064 | select idnum, name, 1 as something from people where name = :b; 3065 | } {a wilma b pebbles} 3066 | } 3067 | -result {{idnum 2 name wilma} {idnum 3 name pebbles something 1}} 3068 | } 3069 | 3070 | test tdbc::sqlite3-30.6 {Empty result set among multiples} { 3071 | -setup { 3072 | ::db allrows {delete from people} 3073 | set stmt [db prepare { 3074 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 3075 | }] 3076 | $stmt paramtype idnum integer 3077 | $stmt paramtype name varchar 40 3078 | set idnum 1 3079 | foreach name {wilma pebbles barney betty bam-bam} { 3080 | set rs [$stmt execute] 3081 | rename $rs {} 3082 | incr idnum 3083 | } 3084 | rename $stmt {} 3085 | set stmt [::db prepare { 3086 | select idnum from people where name = 'fred'; 3087 | select idnum from people where name = 'barney'; 3088 | }] 3089 | set rs [$stmt execute] 3090 | } 3091 | -body { 3092 | set result {} 3093 | while {1} { 3094 | lappend result resultset 3095 | while {[$rs nextdict row]} { 3096 | lappend result $row 3097 | } 3098 | if {[$rs nextresults] == 0} break 3099 | } 3100 | set result 3101 | } 3102 | -cleanup { 3103 | rename $rs {} 3104 | } 3105 | -result {resultset resultset {idnum 3}} 3106 | } 3107 | 3108 | test tdbc::sqlite3-30.7 {Multiple empty result sets} { 3109 | -setup { 3110 | ::db allrows {delete from people} 3111 | set stmt [db prepare { 3112 | INSERT INTO people(idnum, name, info) VALUES(:idnum, :name, NULL) 3113 | }] 3114 | $stmt paramtype idnum integer 3115 | $stmt paramtype name varchar 40 3116 | set idnum 1 3117 | foreach name {wilma pebbles betty bam-bam} { 3118 | set rs [$stmt execute] 3119 | rename $rs {} 3120 | incr idnum 3121 | } 3122 | rename $stmt {} 3123 | set stmt [::db prepare { 3124 | select idnum from people where name = 'fred'; 3125 | select idnum from people where name = 'barney'; 3126 | }] 3127 | set rs [$stmt execute] 3128 | } 3129 | -body { 3130 | set result {} 3131 | while {1} { 3132 | lappend result resultset 3133 | while {[$rs nextdict row]} { 3134 | lappend result $row 3135 | } 3136 | if {[$rs nextresults] == 0} break 3137 | } 3138 | set result 3139 | } 3140 | -cleanup { 3141 | rename $rs {} 3142 | } 3143 | -result {resultset resultset} 3144 | } 3145 | 3146 | #------------------------------------------------------------------------------- 3147 | 3148 | # Test cleanup. Drop tables and get rid of the test database. 3149 | 3150 | 3151 | catch {::db allrows {DROP TABLE d}} 3152 | catch {::db allrows {DROP TABLE c}} 3153 | catch {::db allrows {DROP TABLE b}} 3154 | catch {::db allrows {DROP TABLE a}} 3155 | catch {::db allrows {DROP TABLE people}} 3156 | 3157 | catch {rename ::db {}} 3158 | removeFile $testFileName $testdir 3159 | removeDirectory tdbctest 3160 | 3161 | cleanupTests 3162 | return 3163 | 3164 | # Local Variables: 3165 | # mode: tcl 3166 | # End: 3167 | --------------------------------------------------------------------------------