tdbc::postgres

		them all. Added code to report the deduced parameter types
		back to the script in the 'params' method. Added code to
		the statement constructor to accept PostgreSQL type cast
		syntax as a way to make prepared statements work when they
		otherwise would give 'could not determine data type' errors.
	* tests/tdbcpostgres.test (tdbc::postgres-18.[45]):
		Added test cases for correct reporting of deduced parameter
		types and for PostgreSQL 

2011-02-20  Kevin B. Kenny  <[email protected]>

	* generic/pqStubInit.c:
		Revised code to look for libpq.so by SONAME as well
		as directly, so that ABI version number is taken into
		account and so that libpq-dev is not required.

	* generic/pqStubInit.c (new file):
	* generic/pqStubs.h (new file):
	* generic/tdbcpostgres.c:
		Modified to load libpq using Tcl_LoadFile and not
		link to its client library, nor include the standard
		pq-fe headers. This change allows tdbc::postgres to
		build when the build system lacks a PostgreSQL installation.
	
2010-04-25  Kevin B. Kenny  <[email protected]>

	* configure.in: Changed TDBC_* environment variables to tdbc_* for
	* README:       better TEA compatibility. Advanced version to 1.0b14.
	* configure:    autoconf 2.59
	
2009-09-29  Kevin B. Kenny  <[email protected]>

	* tests/tdbcpostgres.test: Changed all TEST_* environment variables
				   to TDBCPOSTGRES_* for easier scripting
			 	   of combined builds and tests.
	
2009-09-23  Kevin B. Kenny  <[email protected]>

	* generic/tdbcpostgres.c: Removed an ugly workaround for a
	                          bug in Tcl_SubstObj.
	* configure.in: 
	* README:		Advanced version to 1.0b13
	* configure:		autoconf 2.59
	
2009-09-19  Kevin B. Kenny  <[email protected]>

	* configure (New file): autoconf 2.59
		(Added pre-built 'configure' so that TEA users don't
		need autoconf, m4 and all that stuff pre-installed)
	* generic/tdbcpostgres.c:   Many changes to upgrade to Tcl Engineering
	* library/tdbcpostgres.tcl: Manual conventions and correct memory
	* tests/current.test:       mismanagement. Introduced a workaround
			            for a suspected bug in Tcl_SubstObj.
	
2009-09-01  Kevin B. Kenny  <[email protected]>

	Accepted tdbcpostgres from Slawomir Cygan for inclusion in
	the standard tdbc driver distribution.
	
2009-06-22  Slawomir Cygan  <[email protected]>
	Initial baseline of a TDBC driver for Postgres.

shell: binaries libraries
	@$(TCLSH) $(SCRIPT)

gdb:
	$(TCLSH_ENV) $(PKG_ENV) $(GDB) $(TCLSH_PROG) $(SCRIPT)

gdb-test: binaries libraries 
	$(TCLSH_ENV) $(PKG_ENV) $(GDB) \
	    --args $(TCLSH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` \
	    $(TESTFLAGS) -singleproc 1 \
	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
		[list load `@CYGPATH@ $(PKG_LIB_FILE)` $(PACKAGE_NAME)]"

valgrind: binaries libraries

Issues:
 
-timeout configuration option now only sets connect_timeout option for PGconnect(), so the value
has now nothing to do with timeouts during operation (only with connection process to server). It's left as 
readonly for now, but needs some improval or renaming. 

pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir
runstatedir
localstatedir
sharedstatedir
sysconfdir
datadir
datarootdir
libexecdir
sbindir

sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datarootdir='${prefix}/share'
datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
infodir='${datarootdir}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'

  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
    psdir=$ac_optarg ;;

  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil)
    silent=yes ;;

  -runstatedir | --runstatedir | --runstatedi | --runstated \
  | --runstate | --runstat | --runsta | --runst | --runs \
  | --run | --ru | --r)
    ac_prev=runstatedir ;;
  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
  | --run=* | --ru=* | --r=*)
    runstatedir=$ac_optarg ;;

  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
    ac_prev=sbindir ;;
  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
  | --sbi=* | --sb=*)
    sbindir=$ac_optarg ;;

  -sharedstatedir | --sharedstatedir | --sharedstatedi \

  esac
fi

# Check all directory arguments for consistency.
for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
		datadir sysconfdir sharedstatedir localstatedir includedir \
		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
		libdir localedir mandir runstatedir
do
  eval ac_val=\$$ac_var
  # Remove trailing slashes.
  case $ac_val in
    */ )
      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
      eval $ac_var=\$ac_val;;

Fine tuning of the installation directories:
  --bindir=DIR            user executables [EPREFIX/bin]
  --sbindir=DIR           system admin executables [EPREFIX/sbin]
  --libexecdir=DIR        program executables [EPREFIX/libexec]
  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
  --libdir=DIR            object code libraries [EPREFIX/lib]
  --includedir=DIR        C header files [PREFIX/include]
  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
  --infodir=DIR           info documentation [DATAROOTDIR/info]
  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]

    # If the user did not set CFLAGS, set it now to keep macros
    # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2".
    if test "${CFLAGS+set}" != "set" ; then
	CFLAGS=""
    fi

    case "`uname -s`" in
	*win32*|*WIN32*|*MINGW32_*|*MINGW64_*)
	    # Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CYGPATH+:} false; then :
  $as_echo_n "(cached) " >&6
else

    # standard manufacturer compiler.

    if test "$GCC" = yes; then :

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*|MINGW32_*|MINGW64_*) ;;
	    IRIX*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    windows) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac

# This also calls AC_PROG_CC and a few others to create the basic setup
# necessary to compile executables.
#-----------------------------------------------------------------------

TEA_SETUP_COMPILER

#-----------------------------------------------------------------------
# Setup inlining if available. Check sizeof long long, long. 
#-----------------------------------------------------------------------

AC_C_INLINE
AC_CHECK_TYPE([long long],[
    AC_DEFINE([HAVE_LONG_LONG],[1])
    AC_CHECK_SIZEOF([long long])
],[],[])

 *
 *-----------------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_LoadHandle
PostgresqlInitStubs(Tcl_Interp* interp)
{
    int i, j;

    int status;			/* Status of Tcl library calls */
    Tcl_Obj* path;		/* Path name of a module to be loaded */
    Tcl_Obj* shlibext;		/* Extension to use for load modules */
    Tcl_LoadHandle handle = NULL;
				/* Handle to a load module */

    /* Determine the shared library extension */

    { "-timeout",  TYPE_STRING,    INDX_TOUT,	0,		     NULL},
    { "-sslmode",  TYPE_STRING,    INDX_SSLM,	0,		     NULL},
    { "-requiressl", TYPE_STRING,  INDX_RSSL,	0,		     NULL},
    { "-krbsrvname", TYPE_STRING,  INDX_KERB,	0,		     NULL},
    { "-encoding", TYPE_ENCODING,  0,		CONN_OPT_FLAG_MOD,   NULL},
    { "-isolation", TYPE_ISOLATION, 0,		CONN_OPT_FLAG_MOD,   NULL},
    { "-readonly", TYPE_READONLY,  0,		CONN_OPT_FLAG_MOD,   NULL},
    { NULL,	   0,		   0,		0,		     NULL}
};

/*
 * Structure that holds per-interpreter data for the Postgres package.
 *
 *	This structure is reference counted, because it cannot be destroyed
 *	until all connections, statements and result sets that refer to

    int objc,			/* Parameter count */
    Tcl_Obj* const objv[],	/* Parameter data */
    int skip			/* Number of parameters to skip */
) {
    int optionIndex;		/* Index of the current option in
				 * ConnOptions */
    int optionValue;		/* Integer value of the current option */
    int i,j;

    char portval[10];		/* String representation of port number */
    char * encoding = NULL;	/* Selected encoding name */
    int isolation = ISOL_NONE;	/* Isolation level */
    int readOnly = -1;		/* Read only indicator */
#define CONNINFO_LEN 1000
    char connInfo[CONNINFO_LEN]; /* Configuration string for PQconnectdb() */

DeleteConnection(
    ConnectionData* cdata	/* Instance data for the connection */
) {
    if (cdata->pgPtr != NULL) {
	PQfinish(cdata->pgPtr);
    }
    DecrPerInterpRefCount(cdata->pidata);
    ckfree((char*) cdata);
}

/*
 *-----------------------------------------------------------------------------
 *
 * CloneConnection --
 *

GenStatementName(
    ConnectionData* cdata	/* Instance data for the connection */
) {
    char stmtName[30];
    char* retval;
    cdata->stmtCounter += 1;
    snprintf(stmtName, 30, "statement%d", cdata->stmtCounter);
    retval = ckalloc(strlen(stmtName) + 1);
    strcpy(retval, stmtName);
    return retval;
}

/*
 *-----------------------------------------------------------------------------
 *

    char * fieldName;
    Tcl_InitHashTable(&names, TCL_STRING_KEYS);
    if (result != NULL) {
	unsigned int fieldCount = PQnfields(result);
	unsigned int i;
	char numbuf[16];
	for (i = 0; i < fieldCount; ++i) {
	    int new;
	    int count = 1;
	    Tcl_Obj* nameObj;
	    Tcl_HashEntry* entry;
	    fieldName = PQfname(result, i);
	    nameObj = Tcl_NewStringObj(fieldName, -1);
	    Tcl_IncrRefCount(nameObj);
	    entry =
		Tcl_CreateHashEntry(&names, fieldName, &new);
	    while (!new) {
	        count = PTR2INT(Tcl_GetHashValue(entry));
		++count;
		Tcl_SetHashValue(entry, INT2PTR(count));
		sprintf(numbuf, "#%d", count);
		Tcl_AppendToObj(nameObj, numbuf, -1);
		entry = Tcl_CreateHashEntry(&names, Tcl_GetString(nameObj),
					    &new);
	    }
	    Tcl_SetHashValue(entry, INT2PTR(count));
	    Tcl_ListObjAppendElement(NULL, retval, nameObj);
	    Tcl_DecrRefCount(nameObj);
	}
    }
    Tcl_DeleteHashTable(&names);

	UnallocateStatement(sdata->cdata->pgPtr, sdata->stmtName);
	ckfree(sdata->stmtName);
    }
    if (sdata->nativeSql != NULL) {
	Tcl_DecrRefCount(sdata->nativeSql);
    }
    if (sdata->params != NULL) {
	ckfree((char*)sdata->params);
    }
    if (sdata->paramDataTypes != NULL) {
	ckfree((char*)sdata->paramDataTypes);
    }
    Tcl_DecrRefCount(sdata->subVars);
    DecrConnectionRefCount(sdata->cdata);
    ckfree((char*)sdata);
}

/*
 *-----------------------------------------------------------------------------
 *
 * CloneStatement --
 *

	    sdata->paramTypesChanged = 0;
	}
    }

    paramValues = (const char**) ckalloc(sdata->nParams * sizeof(char* ));
    paramLengths = (int*) ckalloc(sdata->nParams * sizeof(int*));
    paramFormats = (int*) ckalloc(sdata->nParams * sizeof(int*));
    paramNeedsFreeing = ckalloc(sdata->nParams);
    paramTempObjs = (Tcl_Obj**) ckalloc(sdata->nParams * sizeof(Tcl_Obj*));

    memset(paramNeedsFreeing, 0, sdata->nParams);
    for (i = 0; i < sdata->nParams; i++) {
	paramTempObjs[i] = NULL;
    }

	if (paramValObj != NULL) {
	    char * bufPtr;
	    int32_t tmp32;
	    int16_t tmp16;

	    switch (sdata->paramDataTypes[i]) {
	    case INT2OID:
		bufPtr = ckalloc(sizeof(int));
		if (Tcl_GetIntFromObj(interp, paramValObj,
				      (int*) bufPtr) != TCL_OK) {
		    goto freeParamTables;
		}
		paramValues[i]=ckalloc(sizeof(int16_t));
		paramNeedsFreeing[i] = 1;
		tmp16 = *(int*) bufPtr;
		ckfree(bufPtr);
		*(int16_t*)(paramValues[i])=htons(tmp16);
		paramFormats[i] = 1;
		paramLengths[i] = sizeof(int16_t);
		break;

	    case INT4OID:
		bufPtr = ckalloc(sizeof(long));
		if (Tcl_GetLongFromObj(interp, paramValObj,
				       (long*) bufPtr) != TCL_OK) {
		    goto freeParamTables;
		}
		paramValues[i]=ckalloc(sizeof(int32_t));
		paramNeedsFreeing[i] = 1;
		tmp32 = *(long*) bufPtr;
		ckfree(bufPtr);
		*((int32_t*)(paramValues[i]))=htonl(tmp32);
		paramFormats[i] = 1;
		paramLengths[i] = sizeof(int32_t);
		break;

    status = TCL_OK;

    /* Clean up allocated memory */

 freeParamTables:
    for (i = 0; i < sdata->nParams; ++i) {
	if (paramNeedsFreeing[i]) {
	    ckfree((char*) paramValues[i]);
	}
	if (paramTempObjs[i] != NULL) {
	    Tcl_DecrRefCount(paramTempObjs[i]);
	}
    }

    ckfree((char*)paramValues);
    ckfree((char*)paramLengths);
    ckfree((char*)paramFormats);
    ckfree((char*)paramNeedsFreeing);
    ckfree((char*)paramTempObjs);

    return status;

}

/*
 *-----------------------------------------------------------------------------

	    sdata->flags &= ~ STMT_FLAG_BUSY;
	}
    }
    if (rdata->execResult != NULL) {
	PQclear(rdata->execResult);
    }
    DecrStatementRefCount(rdata->sdata);
    ckfree((char*)rdata);
}

/*
 *-----------------------------------------------------------------------------
 *
 * CloneResultSet --
 *

 * Side effects:
 *	Creates the ::tdbc::postgres namespace and the commands that reside in it.
 *	Initializes the POSTGRES environment.
 *
 *-----------------------------------------------------------------------------
 */




extern DLLEXPORT int
Tdbcpostgres_Init(
    Tcl_Interp* interp		/* Tcl interpreter */
) {

    PerInterpData* pidata;	/* Per-interpreter data for this package */
    Tcl_Obj* nameObj;		/* Name of a class or method being looked up */
    Tcl_Object curClassObject;  /* Tcl_Object representing the current class */

    pidata->refCount = 1;
    for (i = 0; i < LIT__END; ++i) {
	pidata->literals[i] = Tcl_NewStringObj(LiteralValues[i], -1);
	Tcl_IncrRefCount(pidata->literals[i]);
    }
    Tcl_InitHashTable(&(pidata->typeNumHash), TCL_ONE_WORD_KEYS);
    for (i = 0; dataTypes[i].name != NULL; ++i) {
	int new;
	Tcl_HashEntry* entry =
	    Tcl_CreateHashEntry(&(pidata->typeNumHash),
				INT2PTR(dataTypes[i].oid),
				&new);
	Tcl_Obj* nameObj = Tcl_NewStringObj(dataTypes[i].name, -1);
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(entry, (ClientData) nameObj);
    }


    /*

	}
    }
    ++pgRefCount;
    Tcl_MutexUnlock(&pgMutex);

    return TCL_OK;
}




/*
 *-----------------------------------------------------------------------------
 *
 * DeletePerInterpData --
 *
 *	Delete per-interpreter data when the POSTGRES package is finalized

       Tcl_DecrRefCount(nameObj);
   }
   Tcl_DeleteHashTable(&(pidata->typeNumHash));

   for (i = 0; i < LIT__END; ++i) {
       Tcl_DecrRefCount(pidata->literals[i]);
   }
   ckfree((char *) pidata);

   Tcl_MutexLock(&pgMutex);
   if (--pgRefCount == 0) {
       Tcl_FSUnloadFile(NULL, pgLoadHandle);
       pgLoadHandle = NULL;
   }
   Tcl_MutexUnlock(&pgMutex);

    # available options.)

    # The 'statementCreate' method delegates to the constructor of the
    # statement class

    forward statementCreate ::tdbc::postgres::statement create

    
    # The 'prepareCall' method gives a portable interface to prepare
    # calls to stored procedures.  It delegates to 'prepare' to do the
    # actual work.

    method preparecall {call} {
	regexp {^[[:space:]]*(?:([A-Za-z_][A-Za-z_0-9]*)[[:space:]]*=)?(.*)} \
	    $call -> varName rest
	if {$varName eq {}} {
	    my prepare \\{$rest\\}
	} else {
	    my prepare \\{:$varName=$rest\\}
	}
    }

    # The 'init', 'begintransaction', 'commit, 'rollback', 'tables' 
    #  and 'columns' methods are implemented in C.

}

#------------------------------------------------------------------------------
#
# tdbc::postgres::statement --

    #     -- Executes the statement against the database, optionally providing
    #        a dictionary of substituted parameters (default is to get params
    #        from variables in the caller's scope).
    # columns
    #     -- Returns a list of the names of the columns in the result.
    # nextdict
    #     -- Stores the next row of the result set in the given variable in
    #        the caller's scope as a dictionary whose keys are 
    #        column names and whose values are column values, or else
    #        as a list of cells.
    # nextlist
    #     -- Stores the next row of the result set in the given variable in
    #        the caller's scope as a list of cells.
    # rowcount
    #     -- Returns a count of rows affected by the statement, or -1
    #        if the count of rows has not been determined.

}

FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal 
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license. 

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: all.tcl,v 1.4 2004/07/04 22:04:20 patthoyts Exp $

package require Tcl 8.6
package require tcltest 2.2
::tcltest::configure \
    -testdir [file dirname [file normalize [info script]]] \
    {*}$argv

    -returnCodes error
    -match glob
    -result {wrong # args*}
}

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

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

test tdbc::postgres-2.4 {semicolons in statements} {*}{
    -body {

    -cleanup {
	rename $stmt {}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
    
test tdbc::postgres-5.3 {paramtype - bad type} {*}{
    -setup {
	set stmt [::db prepare {
	    INSERT INTO people(idnum, name, info) values(:idnum, :name, 0)
	}]
    }
    -body {

    }
    -cleanup {
	rename $rs {}
	rename $stmt {}
    }
    -result {fred wilma pebbles barney betty bam-bam}
}
 
test tdbc::postgres-8.4 {anonymous columns - dicts} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT COUNT(*), MAX(idnum) FROM people
	}]
	set rs [$stmt execute]
    }

    }
    -cleanup {
	$stmt close
    }
    -result {1 {6 6} 0}
};

   
test tdbc::postgres-8.2 {nextrow - as lists} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people ORDER BY idnum
	}]
	set rs [$stmt execute]
    }

	list [$rs nextrow -as lists -- row] $row [$rs nextrow -as lists -- row]
    }
    -cleanup {
	$stmt close
    }
    -result {1 {1 fred {}} 0}
}
	
test tdbc::postgres-9.1 {rs foreach var script} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}]
	set rs [$stmt execute]
    }

	$rs foreach row
    }
    -cleanup {
	$rs close
	$stmt close
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-9.38 {stmt foreach - too few args} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people
	}]
    }
    -body {
	$stmt foreach row
    }
    -cleanup {
	$stmt close
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-9.39 {db foreach - too few args} {*}{
    -body {
	db foreach row {
	    SELECT idnum, name FROM people
	}
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-9.40 {rs foreach - too many args} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people
	}]
	set rs [$stmt execute]
    }
    -body {
	$rs foreach row do something 
    }
    -cleanup {
	$rs close
	$stmt close
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-9.41 {stmt foreach - too many args} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people
	}]
    }
    -body {
	$stmt foreach row do something else
    }
    -cleanup {
	$stmt close
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-9.42 {db foreach - too many args} {*}{
    -body {
	db foreach row {
	    SELECT idnum, name FROM people
	} {} do something
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-10.1 {allrows - no args} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'

test tdbc::postgres-10.6 {allrows --} {*}{
    -body {
	db allrows -- {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}
    }
    -result {{idnum 4 name barney} {idnum 5 name betty} {idnum 6 name bam-bam}}
}    

test tdbc::postgres-10.7 {allrows -as lists} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}]
	set rs [$stmt execute]

    -body {
	db allrows -as lists {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}
    }
    -result {{4 barney} {5 betty} {6 bam-bam}}
}
    
test tdbc::postgres-10.10 {allrows -as lists --} {*}{
    -setup {
	set stmt [::db prepare {
	    SELECT idnum, name FROM people WHERE name LIKE 'b%'
	}]
	set rs [$stmt execute]
    }

    -body {
	$stmt allrows {} rubbish
    }
    -cleanup {
	$stmt close
    }
    -returnCodes error
    -result {wrong # args*} 
    -match glob
}

test tdbc::postgres-10.21 {bad -as} {*}{
    -body {
	db allrows -as trash {
	    SELECT idnum, name FROM people

-result {}
}

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

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


test tdbc::postgres-17.1 {database columns - wrong # args} {*}{
    -body {
	set dict [::db columns people % rubbish]

    }
    -result {idnum integer 32 0 0 info integer 32 0 1}
}

test tdbc::postgres-18.1 {$statement params - excess arg} {*}{
    -setup {
	set s [::db prepare {
	    SELECT name FROM people 
	    WHERE name LIKE :pattern
	    AND idnum >= :minid
	}]
	$s paramtype minid numeric 10 0
	$s paramtype pattern varchar 40
    }
    -body {
	$s params excess
    } 
    -cleanup {
	rename $s {}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test tdbc::postgres-18.2 {$statement params - no params} {*}{
    -setup {
	set s [::db prepare {
	    SELECT name FROM people 
	}]
    }
    -body {
	$s params
    } 
    -cleanup {
	rename $s {}
    }
    -result {}
}

test tdbc::postgres-18.3 {$statement params - try a few data types} {*}{
    -setup {
	set s [::db prepare {
	    SELECT name FROM people 
	    WHERE name LIKE :pattern
	    AND idnum >= :minid
	}]
	$s paramtype minid decimal 10 0
	$s paramtype pattern varchar 40
    }
    -body {
	set d [$s params]
	list \
	    [dict get $d minid direction] \
	    [dict get $d minid type] \
	    [dict get $d minid precision] \
	    [dict get $d minid scale] \
	    [dict get $d pattern direction] \
	    [dict get $d pattern type] \
	    [dict get $d pattern precision]
    } 
    -cleanup {
	rename $s {}
    }
    -result {in decimal 10 0 in varchar 40}
}

test tdbc::postgres-18.4 {$statement params - default param types} {
    -setup {
	set s [::db prepare {
	    SELECT name FROM people 
	    WHERE name LIKE :pattern
	    AND idnum >= :minid
	}]
    }
    -body {
	set d [$s params]
	list \
	    [dict get $d minid direction] \
	    [dict get $d minid type] \
	    [dict get $d minid precision] \
	    [dict get $d minid scale] \
	    [dict get $d pattern direction] \
	    [dict get $d pattern type] \
	    [dict get $d pattern precision] \
	    [dict get $d pattern scale]
    } 
    -cleanup {
	rename $s {}
    }
    -result {in integer 0 0 in text 0 0}
}

test tdbc::postgres-18.5 {statement with parameter of indeterminate type} {

test tdbc::postgres-19.13 {$connection configure - -readonly} {*}{
    -body {
	list [::db configure -readonly] \
	    [::db configure -readonly 1] \
	    [::db configure -readonly] \
	    [::db configure -readonly 0] \
	    [::db configure -readonly] 
    }
    -result {0 {} 1 {} 0}
}

test tdbc::postgres-19.14 {$connection configure - -timeout} {*}{
    -body {
	::db configure -timeout junk

    -returnCodes error \
    -result {"-user" option cannot be changed dynamically} \


test tdbc::postgres-22.1 {duplicate column name} {*}{
    -body {
	set stmt [::db prepare {
	    SELECT a.idnum, b.idnum 
	    FROM people a, people b
	    WHERE a.name = 'hud rockstone' 
	    AND b.info = a.info
	}]
	set rs [$stmt execute]
	$rs columns
    }
    -result {idnum idnum#2}
    -cleanup {

		xvarc1 VARCHAR(256),
		xchar1 CHAR(20)
	    )
	}
	set stmt [db prepare {
	    INSERT INTO typetest(
		xsmall1,	xint1,		xfloat1,
		xdouble1,	xtimestamp1,	xbig1,	    
		xdate1,		xtime1,		xbit1,
		xdec1,		xtext1,		xvarb1,
		xvarc1,		xchar1
	    ) values (
		:xsmall1,	:xint1,		:xfloat1,
		:xdouble1,	:xtimestamp1,	:xbig1,	
		:xdate1,	:xtime1,	:xbit1,
		:xdec1,		:xtext1,	:xvarb1,
		:xvarc1,	:xchar1
	    )
	}]
	$stmt paramtype xsmall1 smallint
	$stmt paramtype xint1 integer
	$stmt paramtype xfloat1 float
	$stmt paramtype xdouble1 double
	$stmt paramtype xtimestamp1 timestamp
	$stmt paramtype xbig1 bigint
	$stmt paramtype xdate1 date
	$stmt paramtype xtime1 time
	$stmt paramtype xbit1 bit 14
	$stmt paramtype xdec1 decimal 10 0
	$stmt paramtype xtext1 text
	$stmt paramtype xvarb1 varbinary
	$stmt paramtype xvarc1 varchar
	$stmt paramtype xchar1 char 20
    } 
    -body {
	set trouble {}
	set xsmall1 0x3039
	set xint1 0xbc614e
	set xfloat1 1.125
	set xdouble1 1.125
	set xtimestamp1 {2001-02-03 04:05:06}
	set xbig1 0xbc614e
	set xdate1 2001-02-03
	set xtime1 04:05:06
	set xbit1 01101000101011
	set xdec1 0xbc614e
	set xtext1 $bigtext
	set xvarb1 $bigbinary
	set xvarc1 $bigtext
	set xchar1 [string repeat a 20]
	$stmt allrows
	db foreach row {select * from typetest} {
	    foreach v {
		xsmall1		xint1		xfloat1
		xdouble1	xtimestamp1	xbig1		
		xdate1		xtime1		xbit1
		xdec1		xtext1		xvarb1
		xvarc1		xchar1
	    } {
		if {![dict exists $row $v]} {
		    append trouble $v " did not appear in result set\n"
		} elseif {[set $v] != [dict get $row $v]} {

test tdbc::postgres-23.1 {Primary keys - no arg} {*}{
    -body {
	::db primarykeys
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
} 
test tdbc::postgres-23.2 {Primary keys - no primary key} {*}{
    -body {
	::db primarykeys d
    }
    -result {}
}
test tdbc::postgres-23.3 {Primary keys - simple primary key} {*}{

#------------------------------------------------------------- -*- makefile -*-
#
# Makefile for TBDC Postgres interface
#
# Basic build, test and install
#   nmake /s /nologo /f makefile.vc INSTALLDIR=c:\path\to\installdir TCLDIR=c:\path\to\tcl\source
#   nmake /s /nologo /f makefile.vc INSTALLDIR=c:\path\to\installdir TCLDIR=c:\path\to\tcl\source test
#   nmake /s /nologo /f makefile.vc INSTALLDIR=c:\path\to\installdir TCLDIR=c:\path\to\tcl\source install
#
# For other build options (debug, static etc.)
# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
# detailed documentation.
# 
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

PROJECT = tdbcpostgres
# Tcl 8.6 etc. compile with /DUNICODE. TDBC pre-nmake reform compiled