tdbc::postgres

Check-in [73927d5321]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Update to latest TEA. Make tdbcpostgres work when compiled with C++ compiler.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 73927d53212191e43baa9851334371f3a5c1083e3bdabaf30942ee5b655a0bdc
User & Date: jan.nijtmans 2019-08-30 13:00:31
Context
2019-10-04
17:14
Bump to version 1.1.1 for release. check-in: d257b368a3 user: dgp tags: trunk
2019-08-30
13:00
Update to latest TEA. Make tdbcpostgres work when compiled with C++ compiler. check-in: 73927d5321 user: jan.nijtmans tags: trunk
2019-08-29
11:14
Updated to latest Tcl nmake files. Bug fix [d6c4db25560b1a8c3a26f9369e57cf00327cb9b4]. check-in: 97fa64132b user: apnadkarni tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
...
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
		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.






|







 







|





|





|




|


|









|




|


96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
...
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
		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.

Changes to Makefile.in.

251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
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) `@[email protected] $(srcdir)/tests/all.tcl` \
	    $(TESTFLAGS) -singleproc 1 \
	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
		[list load `@[email protected] $(PKG_LIB_FILE)` $(PACKAGE_NAME)]"

valgrind: binaries libraries






|







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
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) `@[email protected] $(srcdir)/tests/all.tcl` \
	    $(TESTFLAGS) -singleproc 1 \
	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
		[list load `@[email protected] $(PKG_LIB_FILE)` $(PACKAGE_NAME)]"

valgrind: binaries libraries

Changes to TODO.

1
2
3
4
5
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. 
|

|
|
1
2
3
4
5
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.

Changes to configure.

718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
...
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
....
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
....
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
....
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
....
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
....
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
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






<







 







<







 







<
<
<
<
<
<
<
<
<







 







|







 







<







 







|







 







|







718
719
720
721
722
723
724

725
726
727
728
729
730
731
...
798
799
800
801
802
803
804

805
806
807
808
809
810
811
....
1050
1051
1052
1053
1054
1055
1056









1057
1058
1059
1060
1061
1062
1063
....
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
....
1340
1341
1342
1343
1344
1345
1346

1347
1348
1349
1350
1351
1352
1353
....
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
....
7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir

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'

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 ;;










  -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
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]

  --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_*|*MSYS_*)
	    # 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_*|MSYS_*) ;;
	    IRIX*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    windows) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac

Changes to configure.ac.

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
# 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])
],[],[])






|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
# 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])
],[],[])

Changes to generic/pqStubInit.c.

109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
 *
 *-----------------------------------------------------------------------------
 */

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 */






|
>







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
 *
 *-----------------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_LoadHandle
PostgresqlInitStubs(Tcl_Interp* interp)
{
    int i;
    size_t 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 */

Changes to generic/tdbcpostgres.c.

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
....
1034
1035
1036
1037
1038
1039
1040
1041

1042
1043
1044
1045
1046
1047
1048
....
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
....
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
....
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
....
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
....
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
....
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
....
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
....
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
....
3207
3208
3209
3210
3211
3212
3213



3214
3215
3216
3217
3218
3219
3220
3221
....
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
....
3366
3367
3368
3369
3370
3371
3372



3373
3374
3375
3376
3377
3378
3379
....
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
    { "-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);






|







 







|
>







 







|







 







|







 







|







|
|






|







 







|


|



|







 







|







 







|




|









|




|







 







|






|
|
|
|
|







 







|







 







>
>
>
|







 







|



|







 







>
>
>







 







|







215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
....
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
....
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
....
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
....
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
....
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
....
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
....
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
....
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
....
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
....
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
....
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
....
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
....
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
    { "-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,	   TYPE_STRING,		   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;
    size_t 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(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 = (char *)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 isNew;
	    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, &isNew);
	    while (!isNew) {
	        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),
					    &isNew);
	    }
	    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(sdata->params);
    }
    if (sdata->paramDataTypes != NULL) {
	ckfree(sdata->paramDataTypes);
    }
    Tcl_DecrRefCount(sdata->subVars);
    DecrConnectionRefCount(sdata->cdata);
    ckfree(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 = (char *)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 = (char *)ckalloc(sizeof(int));
		if (Tcl_GetIntFromObj(interp, paramValObj,
				      (int*) bufPtr) != TCL_OK) {
		    goto freeParamTables;
		}
		paramValues[i] = (char *)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 = (char *)ckalloc(sizeof(long));
		if (Tcl_GetLongFromObj(interp, paramValObj,
				       (long*) bufPtr) != TCL_OK) {
		    goto freeParamTables;
		}
		paramValues[i] = (char *)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(paramValues[i]);
	}
	if (paramTempObjs[i] != NULL) {
	    Tcl_DecrRefCount(paramTempObjs[i]);
	}
    }

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

    return status;

}
 
/*
 *-----------------------------------------------------------------------------
................................................................................
	    sdata->flags &= ~ STMT_FLAG_BUSY;
	}
    }
    if (rdata->execResult != NULL) {
	PQclear(rdata->execResult);
    }
    DecrStatementRefCount(rdata->sdata);
    ckfree(rdata);
}
 
/*
 *-----------------------------------------------------------------------------
 *
 * CloneResultSet --
 *
................................................................................
 * Side effects:
 *	Creates the ::tdbc::postgres namespace and the commands that reside in it.
 *	Initializes the POSTGRES environment.
 *
 *-----------------------------------------------------------------------------
 */

#ifdef __cplusplus
extern "C" {
#endif  /* __cplusplus */
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 isNew;
	Tcl_HashEntry* entry =
	    Tcl_CreateHashEntry(&(pidata->typeNumHash),
				INT2PTR(dataTypes[i].oid),
				&isNew);
	Tcl_Obj* nameObj = Tcl_NewStringObj(dataTypes[i].name, -1);
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(entry, (ClientData) nameObj);
    }


    /*
................................................................................
	}
    }
    ++pgRefCount;
    Tcl_MutexUnlock(&pgMutex);

    return TCL_OK;
}
#ifdef __cplusplus
}
#endif  /* __cplusplus */
 
/*
 *-----------------------------------------------------------------------------
 *
 * 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(pidata);

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

Changes to library/tdbcpostgres.tcl.

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
    # 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.

}






|







 







|







 







|










34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
    # 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.

}

Changes to license.terms.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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. 






|







|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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.

Changes to tests/all.tcl.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#
# 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
::tcltest::runAllTests






|








2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#
# 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
::tcltest::runAllTests

Changes to tests/tdbcpostgres.test.

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
...
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
...
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
...
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
...
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
....
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
....
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
....
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
....
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
....
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
....
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
....
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
....
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
....
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
....
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
....
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
....
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
....
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
....
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
....
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
....
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
    -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 {
................................................................................
	    [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 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 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 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} {*}{






|







|







 







|







 







|







 







|







 







|







 







|







 







|










|











|






|







 







|










|







 







|







 







|







 







|







 







|







|







 







|








|











|




|









|







 







|









|







 







|







 







|







 







|

|







 







|





|







 







|







 







|







 







|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
...
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
...
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
...
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
...
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
....
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
....
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
....
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
....
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
....
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
....
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
....
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
....
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
....
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
....
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
....
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
....
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
....
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
....
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
....
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
....
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
    -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 {
................................................................................
	    [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 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 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 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} {*}{

Changes to win/makefile.vc.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#   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






|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#   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