summaryrefslogtreecommitdiffstats
path: root/library/comdlg.tcl
Commit message (Expand)AuthorAgeFilesLines
* * library/bgerror.tcl: Updates to use Tcl 8.4 features. [Patch 12377...dgp2006-01-251-10/+5
* typo fixdgp2005-07-251-2/+2
* Apply some of the changes suggested in [Patch 1237759]dkf2005-07-251-12/+9
* * library/comdlg.tcl: Added Macintosh file type validation todgp2005-04-051-1/+10
* * library/comdlg.tcl (FDGetFileTypes): Set an upper limit on howdkf2003-02-211-2/+10
* Merged changes from feature branch dgp-privates-into-namespace,dgp2001-08-011-52/+58
* * library/safetk.tcl (disallowTk): made disallowTk work in thehobbs2000-04-081-3/+9
* * library/comdlg.tcl: removed tclVerifyInteger and tclSortNoCase,hobbs1999-12-071-16/+1
* 1999-09-01 Jeff Hobbs <hobbs@scriptics.com>hobbs1999-09-021-12/+11
* * Merged 8.1 branch into the main trunkstanton1999-04-161-9/+8
* Replaced SCCS strings, fixed binary filesstanton1998-09-141-1/+1
* plugin updateswelch1998-06-271-18/+18
* Initial revisionrjohnson1998-04-011-0/+308
generated by cgit v0.12 at 2024-11-30 17:46:23 (GMT)
FromObj(objv[objIndex], &size); + stringLen = Tcl_NumUtfChars(ptrValue, size); + if (gotPrecision && (precision < stringLen)) { + stringLen = precision; + } + size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; + if (width > stringLen) { + size += (width - stringLen); + } + break; + case 'c': + if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ + objv[objIndex], &intValue) != TCL_OK) { goto fmtError; - default: { - char buf[40]; - sprintf(buf, "bad field specifier \"%c\"", *format); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + whichValue = CHAR_VALUE; + size = width + TCL_UTF_MAX; + break; + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */ + objv[objIndex], &doubleValue) != TCL_OK) { goto fmtError; } + whichValue = DOUBLE_VALUE; + size = MAX_FLOAT_SIZE; + if (precision > 10) { + size += precision; + } + break; + case 0: + Tcl_SetResult(interp, + "format string ended in middle of field specifier", + TCL_STATIC); + goto fmtError; + default: + { + char buf[40]; + + sprintf(buf, "bad field specifier \"%c\"", *format); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + goto fmtError; + } } objIndex++; format++; @@ -2290,103 +2304,99 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) dstSize = size; } switch (whichValue) { - case DOUBLE_VALUE: { - sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */ - break; - } + case DOUBLE_VALUE: + sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */ + break; #ifndef TCL_WIDE_INT_IS_LONG - case WIDE_VALUE: { - sprintf(dst, newFormat, wideValue); - break; - } + case WIDE_VALUE: + sprintf(dst, newFormat, wideValue); + break; #endif /* TCL_WIDE_INT_IS_LONG */ - case INT_VALUE: { - if (useShort) { - sprintf(dst, newFormat, (short) intValue); - } else { - sprintf(dst, newFormat, intValue); - } - break; + case INT_VALUE: + if (useShort) { + sprintf(dst, newFormat, (short) intValue); + } else { + sprintf(dst, newFormat, intValue); } - case CHAR_VALUE: { - char *ptr; - char padChar = (gotZero ? '0' : ' '); - ptr = dst; - if (!gotMinus) { - for ( ; --width > 0; ptr++) { - *ptr = padChar; - } - } - ptr += Tcl_UniCharToUtf(intValue, ptr); + break; + case CHAR_VALUE: { + char *ptr; + char padChar = (gotZero ? '0' : ' '); + ptr = dst; + if (!gotMinus) { for ( ; --width > 0; ptr++) { *ptr = padChar; } - *ptr = '\0'; - break; } - case STRING_VALUE: { - char *ptr; - char padChar = (gotZero ? '0' : ' '); - int pad; - - ptr = dst; - if (width > stringLen) { - pad = width - stringLen; - } else { - pad = 0; - } + ptr += Tcl_UniCharToUtf(intValue, ptr); + for ( ; --width > 0; ptr++) { + *ptr = padChar; + } + *ptr = '\0'; + break; + } + case STRING_VALUE: { + char *ptr; + char padChar = (gotZero ? '0' : ' '); + int pad; - if (!gotMinus) { - while (pad > 0) { - *ptr++ = padChar; - pad--; - } - } + ptr = dst; + if (width > stringLen) { + pad = width - stringLen; + } else { + pad = 0; + } - size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; - if (size) { - memcpy(ptr, ptrValue, (size_t) size); - ptr += size; - } + if (!gotMinus) { while (pad > 0) { *ptr++ = padChar; pad--; } - *ptr = '\0'; - break; } - default: { - sprintf(dst, newFormat, ptrValue); - break; + + size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue; + if (size) { + memcpy(ptr, ptrValue, (size_t) size); + ptr += size; + } + while (pad > 0) { + *ptr++ = padChar; + pad--; } + *ptr = '\0'; + break; + } + default: + sprintf(dst, newFormat, ptrValue); + break; } Tcl_AppendToObj(resultPtr, dst, -1); } } Tcl_SetObjResult(interp, resultPtr); - if(dst != staticBuf) { - ckfree(dst); + if (dst != staticBuf) { + ckfree(dst); } return TCL_OK; mixedXPG: Tcl_SetResult(interp, - "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC); + "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC); goto fmtError; badIndex: if (gotXpg) { - Tcl_SetResult(interp, - "\"%n$\" argument index out of range", TCL_STATIC); + Tcl_SetResult(interp, + "\"%n$\" argument index out of range", TCL_STATIC); } else { - Tcl_SetResult(interp, - "not enough arguments for all format specifiers", TCL_STATIC); + Tcl_SetResult(interp, + "not enough arguments for all format specifiers", TCL_STATIC); } fmtError: - if(dst != staticBuf) { - ckfree(dst); + if (dst != staticBuf) { + ckfree(dst); } Tcl_DecrRefCount(resultPtr); return TCL_ERROR; diff --git a/tests/format.test b/tests/format.test index 567bc9e..7374b46 100644 --- a/tests/format.test +++ b/tests/format.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: format.test,v 1.11 2002/06/22 04:19:47 dgp Exp $ +# RCS: @(#) $Id: format.test,v 1.11.2.1 2003/03/14 16:19:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -501,6 +501,9 @@ test format-17.2 {testing %ld with wide} {64bitInts} { test format-17.3 {testing %ld with non-wide} {64bitInts} { format %ld 42 } 42 +test format-17.4 {testing %l with non-integer} { + format %lf 1 +} 1.000000 # cleanup catch {unset a} -- cgit v0.12 From cca3e3c842ce7be6eae3ace0eaadf8748c3ea20d Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 14 Mar 2003 21:48:32 +0000 Subject: Backport of fix for 698146 to remove assumption that time_t is a long... --- ChangeLog | 3 +++ generic/tclCmdAH.c | 16 +++++++++------- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 60d03f2..e6f9771 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2003-03-14 Donal K. Fellows + * generic/tclCmdAH.c (Tcl_FileObjCmd): Remove assumption that file + times and longs are the same size. [Bug #698146] + * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier that indicates we've got a wide int when we're formatting in an integer style. Stops some libc's from going mad. [Bug #702622] diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 8d1387a..e7bd499 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.1 2003/03/14 16:19:11 dkf Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.2 2003/03/14 21:48:46 dkf Exp $ */ #include "tclInt.h" @@ -835,11 +835,12 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } if (objc == 4) { - if (Tcl_GetLongFromObj(interp, objv[3], - (long*)(&buf.st_atime)) != TCL_OK) { + long newTime; + + if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) { return TCL_ERROR; } - tval.actime = buf.st_atime; + tval.actime = newTime; tval.modtime = buf.st_mtime; if (Tcl_FSUtime(objv[2], &tval) != 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), @@ -1071,12 +1072,13 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } if (objc == 4) { - if (Tcl_GetLongFromObj(interp, objv[3], - (long*)(&buf.st_mtime)) != TCL_OK) { + long newTime; + + if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) { return TCL_ERROR; } tval.actime = buf.st_atime; - tval.modtime = buf.st_mtime; + tval.modtime = newTime; if (Tcl_FSUtime(objv[2], &tval) != 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not set modification time for file \"", -- cgit v0.12 From d932fc4e68604d4877fca90b45537258f7ab3100 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 14 Mar 2003 23:19:41 +0000 Subject: Made format less keen on converting numeric types. [Bug #699060] --- ChangeLog | 2 ++ generic/tclCmdAH.c | 51 ++++++++++++++++++++++++++++++++++++++++++--------- tests/format.test | 9 ++++++++- 3 files changed, 52 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index e6f9771..74d3258 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,8 @@ * generic/tclCmdAH.c (Tcl_FileObjCmd): Remove assumption that file times and longs are the same size. [Bug #698146] + (Tcl_FormatObjCmd): Stop surprising type conversions from + happening when working with integer and wide values. [Bug #699060] * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier that indicates we've got a wide int when we're formatting in an diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index e7bd499..596cab0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.2 2003/03/14 21:48:46 dkf Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.3 2003/03/14 23:19:45 dkf Exp $ */ #include "tclInt.h" @@ -2198,21 +2198,55 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) case 'u': case 'x': case 'X': + size = 40 + precision; + #ifndef TCL_WIDE_INT_IS_LONG - if (useWide) { - if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ - objv[objIndex], &wideValue) != TCL_OK) { + /* + * Peek what kind of value we've got so as not to be + * converting stuff unduly. [Bug #699060] + */ + if (objv[objIndex]->typePtr == &tclWideIntType) { + Tcl_GetWideIntFromObj(NULL, objv[objIndex], &wideValue); + if (useWide) { + whichValue = WIDE_VALUE; + break; + } else { + whichValue = INT_VALUE; + intValue = (int) Tcl_WideAsLong(wideValue); + } + } else if (objv[objIndex]->typePtr == &tclIntType) { + Tcl_GetLongFromObj(NULL, objv[objIndex], &intValue); + if (useWide) { + whichValue = WIDE_VALUE; + wideValue = Tcl_LongAsWide(intValue); + break; + } else { + whichValue = INT_VALUE; + } + } else { + /* + * No existing numeric interpretation, so we can + * coerce to whichever is convenient. + */ + if (useWide) { + if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ + objv[objIndex], &wideValue) != TCL_OK) { + goto fmtError; + } + whichValue = WIDE_VALUE; + break; + } + if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ + objv[objIndex], &intValue) != TCL_OK) { goto fmtError; } - whichValue = WIDE_VALUE; - size = 40 + precision; - break; } -#endif /* TCL_WIDE_INT_IS_LONG */ +#else /* TCL_WIDE_INT_IS_LONG */ if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { goto fmtError; } +#endif /* !TCL_WIDE_INT_IS_LONG */ #if (LONG_MAX > INT_MAX) /* * Add the 'l' for long format type because we are on an @@ -2225,7 +2259,6 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) newPtr[-2] = 'l'; #endif /* LONG_MAX > INT_MAX */ whichValue = INT_VALUE; - size = 40 + precision; break; case 's': /* diff --git a/tests/format.test b/tests/format.test index 7374b46..423c476 100644 --- a/tests/format.test +++ b/tests/format.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: format.test,v 1.11.2.1 2003/03/14 16:19:13 dkf Exp $ +# RCS: @(#) $Id: format.test,v 1.11.2.2 2003/03/14 23:19:45 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -504,6 +504,13 @@ test format-17.3 {testing %ld with non-wide} {64bitInts} { test format-17.4 {testing %l with non-integer} { format %lf 1 } 1.000000 +test format-17.5 {type conversions with wides} { + set a 0xAAAAAAAA ;# NB: Careful to make separate objects here! + set b 0xAAAAAAA; append b A + set result [expr {$a == $b}] + format %x $a + lappend result [expr {$a == $b}] +} {1 1} # cleanup catch {unset a} -- cgit v0.12 From 7a9c4243ac433c65c5b5ac2b90bd788b15307548 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 17 Mar 2003 14:25:19 +0000 Subject: Fixed docbug in lsearch and lsort for -ascii opt, which operates on Unicode not ASCII these days. [Bug #703807] --- ChangeLog | 7 +++++++ doc/lsearch.n | 7 ++++--- doc/lsort.n | 5 +++-- 3 files changed, 14 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 74d3258..6567aab 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2003-03-17 Donal K. Fellows + + * doc/lsearch.n: Altered documentation of -ascii options so + * doc/lsort.n: they don't specify that they operate on + ASCII strings, which they never did + anyway. [Bug #703807] + 2003-03-14 Donal K. Fellows * generic/tclCmdAH.c (Tcl_FileObjCmd): Remove assumption that file diff --git a/doc/lsearch.n b/doc/lsearch.n index 77482bf..8fd3c51 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lsearch.n,v 1.13 2002/10/03 13:08:55 dkf Exp $ +'\" RCS: @(#) $Id: lsearch.n,v 1.13.2.1 2003/03/17 14:25:20 dkf Exp $ '\" .so man.macros .TH lsearch n 8.4 Tcl "Tcl Built-In Commands" @@ -37,8 +37,9 @@ matching values if \fB\-inline\fR is specified as well.) .VE 8.4 .TP \fB\-ascii\fR -The list elements are to be examined as ASCII strings. This option is only -meaningful when used with \fB\-exact\fR or \fB\-sorted\fR. +The list elements are to be examined as Unicode strings (the name is +for backward-compatability reasons.) This option is only meaningful +when used with \fB\-exact\fR or \fB\-sorted\fR. .TP \fB\-decreasing\fR The list elements are sorted in decreasing order. This option is only diff --git a/doc/lsort.n b/doc/lsort.n index 34a69d1..1e8a1fd 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -7,7 +7,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: lsort.n,v 1.12 2001/11/14 23:38:39 hobbs Exp $ +'\" RCS: @(#) $Id: lsort.n,v 1.12.4.1 2003/03/17 14:25:20 dkf Exp $ '\" .so man.macros .TH lsort n 8.3 Tcl "Tcl Built-In Commands" @@ -32,7 +32,8 @@ specified before \fIlist\fR to control the sorting process (unique abbreviations are accepted): .TP 20 \fB\-ascii\fR -Use string comparison with ASCII collation order. This is the default. +Use string comparison with Unicode code-point collation order (the +name is for backward-compatability reasons.) This is the default. .TP 20 \fB\-dictionary\fR Use dictionary-style comparison. This is the same as \fB\-ascii\fR -- cgit v0.12 From 546d6ca6ea71958e884437bf65cb7b2421590747 Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Tue, 18 Mar 2003 10:51:28 +0000 Subject: Fixes for three filesystem problems --- ChangeLog | 10 ++++++++++ generic/tclIOUtil.c | 4 +++- tests/cmdAH.test | 6 +++--- win/tclWinFile.c | 12 +++++++++++- 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6567aab..859aed1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2003-03-18 Vince Darley + + * tests/cmdAH.test: fix test suite problem if /home is a symlink + * generic/tclIOUtil.c: fix bad error message with 'cd ""' + * win/tclWinFile.c: allow Tcl to differentiate between reparse + points which are symlinks and mounted drives. + + These changes fix [Bug #703264], [Bug #704917], [Bug #697862] + respectively. + 2003-03-17 Donal K. Fellows * doc/lsearch.n: Altered documentation of -ascii options so diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 29ba700..924689a 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.77 2003/03/03 20:22:41 das Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.1 2003/03/18 10:51:31 vincentdarley Exp $ */ #include "tclInt.h" @@ -2528,6 +2528,8 @@ Tcl_FSChdir(pathPtr) cwdPathPtr = normDirName; Tcl_MutexUnlock(&cwdMutex); } + } else { + Tcl_SetErrno(ENOENT); } return (retVal); diff --git a/tests/cmdAH.test b/tests/cmdAH.test index fe16def..9b26f8e 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdAH.test,v 1.30 2003/01/09 10:38:32 vincentdarley Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.30.2.1 2003/03/18 10:51:31 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -401,7 +401,7 @@ test cmdAH-8.43 {Tcl_FileObjCmd: dirname} { set result [list [catch {file dirname ~} msg] $msg] set env(HOME) $temp set result -} {0 /home} +} [list 0 [expr {([file exists /home] && ([file type /home] == "link")) ? [file readlink /home] : "/home"}]] test cmdAH-8.44 {Tcl_FileObjCmd: dirname} { global env set temp $env(HOME) @@ -419,7 +419,7 @@ test cmdAH-8.45 {Tcl_FileObjCmd: dirname} { set result [list [catch {file dirname ~} msg] $msg] set env(HOME) $temp set result -} {0 /home} +} [list 0 [expr {([file exists /home] && ([file type /home] == "link")) ? [file readlink /home] : "/home"}]] test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { global env set temp $env(HOME) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8213e6d..f44140f 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.44 2003/02/10 12:50:32 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.1 2003/03/18 10:51:31 vincentdarley Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -474,6 +474,16 @@ WinReadLinkDirectory(LinkDirectory) if (0 == strncmp(copy,"\\??\\",4)) { copy += 4; len -= 4; + if (0 == strncmp(copy,"Volume{",7)) { + /* + * This is actually a mounted drive, which is in any + * case treated as being mounted in place, so it is + * in some sense a symlink to itself + */ + Tcl_DStringFree(&ds); + Tcl_SetErrno(EINVAL); + return NULL; + } } else if (0 == strncmp(copy,"\\\\?\\",4)) { copy += 4; len -= 4; -- cgit v0.12 From 9501f8cadf329916ab83d74c5c5aee6edf99ca3c Mon Sep 17 00:00:00 2001 From: das Date: Tue, 18 Mar 2003 13:41:26 +0000 Subject: * tools/tcltk-man2html.tcl: added support for building 'make html' from inside distribution directories named with 8.x.x version numbers. tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x directories found inside its --srcdir argument. --- ChangeLog | 7 +++++++ tools/tcltk-man2html.tcl | 28 +++++++++------------------- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/ChangeLog b/ChangeLog index 859aed1..8a6541a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2003-03-18 Daniel Steffen + + * tools/tcltk-man2html.tcl: added support for building 'make html' + from inside distribution directories named with 8.x.x version + numbers. tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x + directories found inside its --srcdir argument. + 2003-03-18 Vince Darley * tests/cmdAH.test: fix test suite problem if /home is a symlink diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index c5bd2a6..42f0e58 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,8 +1,8 @@ #!/bin/sh # The next line is executed by /bin/sh, but not tcl \ -exec tclsh8.2 "$0" ${1+"$@"} +exec tclsh8.4 "$0" ${1+"$@"} -package require Tcl 8.2 +package require Tcl 8.4 # Convert Ousterhout format man pages into highly crosslinked # hypertext. @@ -65,7 +65,7 @@ package require Tcl 8.2 # Oct 24, 1997 - moved from 8.0b1 to 8.0 release # -set Version "0.30" +set Version "0.31" proc parse_command_line {} { global argv Version @@ -80,10 +80,6 @@ proc parse_command_line {} { set tcldir {} set webdir ../html - # Directory names for Tcl and Tk, in priority order. - set tclDirList {tcl8.4 tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl} - set tkDirList {tk8.4 tk8.3 tk8.2 tk8.1 tk8.0 tk} - # Handle arguments a la GNU: # --version # --help @@ -124,28 +120,22 @@ proc parse_command_line {} { } # Find Tcl. - foreach dir $tclDirList { - if {[file isdirectory $tcltkdir/$dir]} then { - set tcldir $dir - break - } - } + set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ + -directory $tcltkdir {tcl{,[8-9].[0-9]{,.[0-9]}}}]] end] if {$tcldir == ""} then { puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" exit 1 } + puts "using Tcl source directory $tcldir" # Find Tk. - foreach dir $tkDirList { - if {[file isdirectory $tcltkdir/$dir]} then { - set tkdir $dir - break - } - } + set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ + -directory $tcltkdir {tk{,[8-9].[0-9]{,.[0-9]}}}]] end] if {$tkdir == ""} then { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 } + puts "using Tk source directory $tkdir" # the title for the man pages overall global overall_title -- cgit v0.12 From cc539d2683c0e33f8b55a8b886fb36ddf6ca7577 Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Wed, 19 Mar 2003 01:19:50 +0000 Subject: * tests/registry.test: Changed the conditionals to avoid an abort if [testlocale] is missing, as when running the test in tclsh rather than tcltest. [Bug #705677] --- ChangeLog | 6 ++++++ tests/registry.test | 18 ++++++++++-------- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8a6541a..2055a0a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2003-03-18 Kevin Kenny + + * tests/registry.test: Changed the conditionals to avoid an + abort if [testlocale] is missing, as when running the test in + tclsh rather than tcltest. [Bug #705677] + 2003-03-18 Daniel Steffen * tools/tcltk-man2html.tcl: added support for building 'make html' diff --git a/tests/registry.test b/tests/registry.test index 2ace4d5..9e12849 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -10,10 +10,10 @@ # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: registry.test,v 1.12 2002/10/18 23:58:18 hobbs Exp $ +# RCS: @(#) $Id: registry.test,v 1.12.2.1 2003/03/19 01:19:53 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } @@ -29,13 +29,15 @@ if {$tcl_platform(platform) == "windows"} { } # determine the current locale -set old [testlocale all] -if {![string compare [testlocale all ""] "English_United States.1252"]} { - # error messages from registry package are already localized. - set ::tcltest::testConstraints(english) 1 +if { [string compare {} [info commands testlocale]] } { + set old [testlocale all] + testConstraint english \ + [string equal [testlocale all ""] "English_United States.1252"] + testlocale all $old + unset old +} else { + testConstraint english false } -testlocale all $old -unset old set hostname [info hostname] -- cgit v0.12 From a374ad83cefcf100f139968fd2f38021f43d87e3 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 19 Mar 2003 05:24:22 +0000 Subject: revised latest registry test commit --- tests/registry.test | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/tests/registry.test b/tests/registry.test index 9e12849..1b134b6 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -10,7 +10,7 @@ # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: registry.test,v 1.12.2.1 2003/03/19 01:19:53 kennykb Exp $ +# RCS: @(#) $Id: registry.test,v 1.12.2.2 2003/03/19 05:24:22 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -29,15 +29,9 @@ if {$tcl_platform(platform) == "windows"} { } # determine the current locale -if { [string compare {} [info commands testlocale]] } { - set old [testlocale all] - testConstraint english \ - [string equal [testlocale all ""] "English_United States.1252"] - testlocale all $old - unset old -} else { - testConstraint english false -} +testConstraint english [expr {[llength [info commands testlocale]] + && [string equal [testlocale all ""] "English_United States.1252"] +}] set hostname [info hostname] -- cgit v0.12 From 16a00586d956341e0f805b7fe688c5362bccd40f Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 19 Mar 2003 20:06:41 +0000 Subject: * doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors in documentation. [Bug 683994] --- ChangeLog | 6 ++++++ doc/Eval.3 | 5 +++-- doc/ParseCmd.3 | 13 +++++++------ 3 files changed, 16 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2055a0a..e76ed50 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2003-03-19 Don Porter + + * doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and + * doc/ParseCmd.3 (Tcl_EvalTokensStandard): return type errors + in documentation. [Bug 683994] + 2003-03-18 Kevin Kenny * tests/registry.test: Changed the conditionals to avoid an diff --git a/doc/Eval.3 b/doc/Eval.3 index 4b9ecac..774aa55 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Eval.3,v 1.12 2002/08/05 03:24:39 dgp Exp $ +'\" RCS: @(#) $Id: Eval.3,v 1.12.2.1 2003/03/19 20:06:50 dgp Exp $ '\" .so man.macros .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" @@ -91,7 +91,8 @@ can be skipped if the object is evaluated again in the future. The return value from \fBTcl_EvalObjEx\fR (and all the other procedures described here) is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, -\fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. +\fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other +integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 0986d8e..ac03337 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ParseCmd.3,v 1.10 2002/08/05 03:24:39 dgp Exp $ +'\" RCS: @(#) $Id: ParseCmd.3,v 1.10.2.1 2003/03/19 20:06:50 dgp Exp $ '\" .so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" @@ -38,7 +38,7 @@ CONST char * Tcl_Obj * \fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) .sp -Tcl_Obj * +int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr @@ -190,7 +190,8 @@ substitutions requested by the tokens and concatenates the resulting values. The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, -\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. +\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly +some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP @@ -211,9 +212,9 @@ of \fBTcl_EvalTokens\fR is deprecated. return parse information in two data structures, Tcl_Parse and Tcl_Token: .CS typedef struct Tcl_Parse { - char *\fIcommentStart\fR; + CONST char *\fIcommentStart\fR; int \fIcommentSize\fR; - char *\fIcommandStart\fR; + CONST char *\fIcommandStart\fR; int \fIcommandSize\fR; int \fInumWords\fR; Tcl_Token *\fItokenPtr\fR; @@ -223,7 +224,7 @@ typedef struct Tcl_Parse { typedef struct Tcl_Token { int \fItype\fR; - char *\fIstart\fR; + CONST char *\fIstart\fR; int \fIsize\fR; int \fInumComponents\fR; } Tcl_Token; -- cgit v0.12 From dc50ee15ae46a3ae3eda860803ae394bc8ddc86b Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Wed, 19 Mar 2003 22:52:48 +0000 Subject: * generic/tclCompile.c: * tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE [Bug 705406] (Don Porter). Backport from 8.5a0 --- ChangeLog | 6 ++++++ generic/tclCompile.c | 11 +++++++++-- tests/compile.test | 13 ++++++++++++- 3 files changed, 27 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index e76ed50..6307d16 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2003-03-19 Miguel Sofer + + * generic/tclCompile.c: + * tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE + [Bug 705406] (Don Porter). + 2003-03-19 Don Porter * doc/Eval.3 (Tcl_EvalObjEx): Corrected CONST and diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 704178b..19f1e25 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.43 2003/02/19 14:33:39 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.43.2.1 2003/03/19 22:53:11 msofer Exp $ */ #include "tclInt.h" @@ -989,12 +989,19 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) && (cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { + int savedNumCmds = envPtr->numCommands; + code = (*(cmdPtr->compileProc))(interp, &parse, envPtr); if (code == TCL_OK) { goto finishCommand; } else if (code == TCL_OUT_LINE_COMPILE) { - /* do nothing */ + /* + * Restore numCommands to its correct value, removing + * any commands compiled before TCL_OUT_LINE_COMPILE + * [Bug 705406] + */ + envPtr->numCommands = savedNumCmds; } else { /* an error */ /* * There was a compilation error, the last diff --git a/tests/compile.test b/tests/compile.test index e31da81..1d2ae72 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.24 2003/01/08 00:34:59 dgp Exp $ +# RCS: @(#) $Id: compile.test,v 1.24.2.1 2003/03/19 22:53:16 msofer Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -115,6 +115,17 @@ test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} { foo } {2} +test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} { + proc foo {} { + catch { + if {[a]} { + if b {} + } + } + } + list [catch foo msg] $msg +} {1 {invalid command name "a"}} + test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 -- cgit v0.12 From 3e6b1cd7c58db82bcfccf38659be021a9fc2e816 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 20 Mar 2003 22:32:54 +0000 Subject: * generic/tclInt.h: Removed definition of ParseValue struct that is no longer used. --- ChangeLog | 5 +++++ generic/tclInt.h | 33 +-------------------------------- 2 files changed, 6 insertions(+), 32 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6307d16..182e6e3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2003-03-20 Don Porter + + * generic/tclInt.h: Removed definition of ParseValue struct that + is no longer used. + 2003-03-19 Miguel Sofer * generic/tclCompile.c: diff --git a/generic/tclInt.h b/generic/tclInt.h index aea1f4f..fcddd10 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.118 2003/02/10 10:26:25 vincentdarley Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.118.2.1 2003/03/20 22:33:02 dgp Exp $ */ #ifndef _TCLINT @@ -1381,37 +1381,6 @@ typedef struct Interp { #define INTERP_TRACE_IN_PROGRESS 0x200 /* - *---------------------------------------------------------------- - * Data structures related to command parsing. These are used in - * tclParse.c and its clients. - *---------------------------------------------------------------- - */ - -/* - * The following data structure is used by various parsing procedures - * to hold information about where to store the results of parsing - * (e.g. the substituted contents of a quoted argument, or the result - * of a nested command). At any given time, the space available - * for output is fixed, but a procedure may be called to expand the - * space available if the current space runs out. - */ - -typedef struct ParseValue { - char *buffer; /* Address of first character in - * output buffer. */ - char *next; /* Place to store next character in - * output buffer. */ - char *end; /* Address of the last usable character - * in the buffer. */ - void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed)); - /* Procedure to call when space runs out; - * it will make more space. */ - ClientData clientData; /* Arbitrary information for use of - * expandProc. */ -} ParseValue; - - -/* * Maximum number of levels of nesting permitted in Tcl commands (used * to catch infinite recursion). */ -- cgit v0.12 From 7397eb21b5546e2f2db642b3a7fda20d24bfd70b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 21 Mar 2003 03:24:08 +0000 Subject: * generic/tclInt.h (tclOriginalNotifier): * generic/tclStubInit.c (tclOriginalNotifier): * mac/tclMacNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): * unix/tclUnixNotfy.c (Tcl_SetTimer,Tcl_WaitForEvent, Tcl_CreateFileHandler,Tcl_DeleteFileHandler): * win/tclWinNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): Some linkers apparently use a different representation for a pointer to a function within the same compilation unit and a pointer to a function in a different compilation unit. This causes checks like those in the original notifier procedures to fall into infinite loops. The fix is to store pointers to the original notifier procedures in a struct defined in the same compilation unit as the stubs tables, and compare against those values. [Bug 707174] --- ChangeLog | 14 ++++++++++++++ generic/tclInt.h | 3 ++- generic/tclStubInit.c | 25 ++++++++++++++++++++++++- mac/tclMacNotify.c | 7 ++++--- unix/tclUnixNotfy.c | 11 ++++++----- win/tclWinNotify.c | 8 +++++--- 6 files changed, 55 insertions(+), 13 deletions(-) diff --git a/ChangeLog b/ChangeLog index 182e6e3..95cbae6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,19 @@ 2003-03-20 Don Porter + * generic/tclInt.h (tclOriginalNotifier): + * generic/tclStubInit.c (tclOriginalNotifier): + * mac/tclMacNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): + * unix/tclUnixNotfy.c (Tcl_SetTimer,Tcl_WaitForEvent, + Tcl_CreateFileHandler,Tcl_DeleteFileHandler): + * win/tclWinNotify.c (Tcl_SetTimer,Tcl_WaitForEvent): Some linkers + apparently use a different representation for a pointer to a function + within the same compilation unit and a pointer to a function in a + different compilation unit. This causes checks like those in the + original notifier procedures to fall into infinite loops. The fix + is to store pointers to the original notifier procedures in a struct + defined in the same compilation unit as the stubs tables, and compare + against those values. [Bug 707174] + * generic/tclInt.h: Removed definition of ParseValue struct that is no longer used. diff --git a/generic/tclInt.h b/generic/tclInt.h index fcddd10..077c65b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.118.2.1 2003/03/20 22:33:02 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.118.2.2 2003/03/21 03:24:08 dgp Exp $ */ #ifndef _TCLINT @@ -1546,6 +1546,7 @@ extern char * tclDefaultEncodingDir; extern Tcl_ChannelType tclFileChannelType; extern char * tclMemDumpFileName; extern TclPlatformType tclPlatform; +extern Tcl_NotifierProcs tclOriginalNotifier; /* * Variables denoting the Tcl object types defined in the core. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index f303e0a..f70c479 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.79 2003/02/18 02:25:45 hobbs Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.79.2.1 2003/03/21 03:24:08 dgp Exp $ */ #include "tclInt.h" @@ -37,6 +37,29 @@ #endif /* + * Keep a record of the original Notifier procedures, created in the + * same compilation unit as the stub tables so we can later do reliable, + * portable comparisons to see whether a Tcl_SetNotifier() call swapped + * new routines into the stub table. + */ + +Tcl_NotifierProcs tclOriginalNotifier = { + Tcl_SetTimer, + Tcl_WaitForEvent, +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + Tcl_CreateFileHandler, + Tcl_DeleteFileHandler, +#else + NULL, + NULL, +#endif + NULL, + NULL, + NULL, + NULL +}; + +/* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations * below should be made in the generic/tcl.decls script. diff --git a/mac/tclMacNotify.c b/mac/tclMacNotify.c index f27645e..81f4082 100644 --- a/mac/tclMacNotify.c +++ b/mac/tclMacNotify.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacNotify.c,v 1.8 2001/11/23 01:27:53 das Exp $ + * RCS: @(#) $Id: tclMacNotify.c,v 1.8.4.1 2003/03/21 03:24:08 dgp Exp $ */ #include "tclInt.h" @@ -48,6 +48,7 @@ extern pascal QHdrPtr GetEventQueue(void) */ extern TclStubs tclStubs; +extern Tcl_NotifierProcs tclOriginalNotifier; /* * The follwing static indicates whether this module has been initialized. @@ -339,7 +340,7 @@ Tcl_SetTimer( * on the Mac, but mirrors the UNIX hook. */ - if (tclStubs.tcl_SetTimer != Tcl_SetTimer) { + if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); return; } @@ -420,7 +421,7 @@ Tcl_WaitForEvent( * sense on the Mac, but mirrors the UNIX hook. */ - if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) { + if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 94be5a0..7de3417 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixNotfy.c,v 1.11 2002/08/31 06:09:46 das Exp $ + * RCS: @(#) $Id: tclUnixNotfy.c,v 1.11.2.1 2003/03/21 03:24:09 dgp Exp $ */ #include "tclInt.h" @@ -19,6 +19,7 @@ #include extern TclStubs tclStubs; +extern Tcl_NotifierProcs tclOriginalNotifier; /* * This structure is used to keep track of the notifier info for a @@ -353,7 +354,7 @@ Tcl_SetTimer(timePtr) * timeout values to Tcl_WaitForEvent. */ - if (tclStubs.tcl_SetTimer != Tcl_SetTimer) { + if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); } } @@ -412,7 +413,7 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData) FileHandler *filePtr; int index, bit; - if (tclStubs.tcl_CreateFileHandler != Tcl_CreateFileHandler) { + if (tclStubs.tcl_CreateFileHandler != tclOriginalNotifier.createFileHandlerProc) { tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData); return; } @@ -486,7 +487,7 @@ Tcl_DeleteFileHandler(fd) unsigned long flags; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (tclStubs.tcl_DeleteFileHandler != Tcl_DeleteFileHandler) { + if (tclStubs.tcl_DeleteFileHandler != tclOriginalNotifier.deleteFileHandlerProc) { tclStubs.tcl_DeleteFileHandler(fd); return; } @@ -662,7 +663,7 @@ Tcl_WaitForEvent(timePtr) #endif ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) { + if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index b7bb17d..e6fca31 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinNotify.c,v 1.11 2003/01/16 19:02:00 mdejong Exp $ + * RCS: @(#) $Id: tclWinNotify.c,v 1.11.2.1 2003/03/21 03:24:09 dgp Exp $ */ #include "tclWinInt.h" @@ -45,6 +45,8 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; extern TclStubs tclStubs; +extern Tcl_NotifierProcs tclOriginalNotifier; + /* * The following static indicates the number of threads that have * initialized notifiers. It controls the lifetime of the TclNotifier @@ -267,7 +269,7 @@ Tcl_SetTimer( * on Windows, but mirrors the UNIX hook. */ - if (tclStubs.tcl_SetTimer != Tcl_SetTimer) { + if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) { tclStubs.tcl_SetTimer(timePtr); return; } @@ -433,7 +435,7 @@ Tcl_WaitForEvent( * sense on windows, but mirrors the UNIX hook. */ - if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) { + if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) { return tclStubs.tcl_WaitForEvent(timePtr); } -- cgit v0.12 From 668371a4f1e9f90b7d69d55e27ebeef487148ddd Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Sun, 23 Mar 2003 01:34:40 +0000 Subject: Fixed a bug where [package require dde] or [package require registry] attempted to load the release version of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin for the patch. --- ChangeLog | 8 ++++++++ library/dde/pkgIndex.tcl | 2 +- library/reg/pkgIndex.tcl | 2 +- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 95cbae6..54cf21d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2003-03-22 Kevin Kenny + + * library/dde/pkgIndex.tcl: + * library/reg/pkgIndex.tcl: Fixed a bug where [package require dde] + or [package require registry] attempted to load the release version + of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin + for the patch. + 2003-03-20 Don Porter * generic/tclInt.h (tclOriginalNotifier): diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index b651038..49201f4 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,5 +1,5 @@ if {![package vsatisfies [package provide Tcl] 8]} {return} -if {[info exists tcl_platform(debug)]} { +if {[info exists ::tcl_platform(debug)]} { package ifneeded dde 1.2.1 [list load [file join $dir tcldde12g.dll] dde] } else { package ifneeded dde 1.2.1 [list load [file join $dir tcldde12.dll] dde] diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index d4bd27b..230d120 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,5 +1,5 @@ if {![package vsatisfies [package provide Tcl] 8]} {return} -if {[info exists tcl_platform(debug)]} { +if {[info exists ::tcl_platform(debug)]} { package ifneeded registry 1.1.1 \ [list load [file join $dir tclreg11g.dll] registry] } else { -- cgit v0.12 From 11faa6f4300fd411354704845136e378832cdb24 Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Sun, 23 Mar 2003 03:10:09 +0000 Subject: Added quoting around the script name in the 'test' target; Joe Mistachkin insists that he has a configuration that fails to launch tcltest without it, and it appears harmless otherwise. --- ChangeLog | 4 ++++ win/makefile.vc | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 54cf21d..a32a280 100644 --- a/ChangeLog +++ b/ChangeLog @@ -5,6 +5,10 @@ or [package require registry] attempted to load the release version of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin for the patch. + * win/makefile.vc: Added quoting around the script name in the + 'test' target; Joe Mistachkin insists that he has a configuration + that fails to launch tcltest without it, and it appears harmless + otherwise. 2003-03-20 Don Porter diff --git a/win/makefile.vc b/win/makefile.vc index 863fe7f..a2d613d 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,7 +12,7 @@ # Copyright (c) 2001-2002 David Gravereaux. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.100.2.2 2003/03/13 16:26:15 kennykb Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.100.2.3 2003/03/23 03:10:13 kennykb Exp $ #------------------------------------------------------------------------------ !if "$(MSVCDIR)" == "" @@ -421,9 +421,9 @@ install: install-binaries install-libraries install-docs test: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" - $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) + $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) !else - $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) > tests.log + $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) > tests.log type tests.log | more !endif -- cgit v0.12 From 208ca31442c2e1c40f81bd060a735acadfdce4d3 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 24 Mar 2003 00:55:15 +0000 Subject: * generic/tclVar.c: * tests/var.test: fixing ObjMakeUpvar's lookup algorithm for the created local variable, bugs #631741 and #696893. --- ChangeLog | 7 +++++++ generic/tclVar.c | 60 +++++++++++++++++++++++++++++++++++++++----------------- tests/var.test | 12 +++++++++++- 3 files changed, 60 insertions(+), 19 deletions(-) diff --git a/ChangeLog b/ChangeLog index a32a280..12fbcc3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2003-03-24 Miguel Sofer + + * generic/tclVar.c: + * tests/var.test: fixing ObjMakeUpvar's lookup algorithm for the + created local variable, bugs #631741 (Chris Darroch) and #696893 + (David Hilker). + 2003-03-22 Kevin Kenny * library/dde/pkgIndex.tcl: diff --git a/generic/tclVar.c b/generic/tclVar.c index 11868fd..d3778c6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,12 +15,13 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.69 2002/11/12 02:23:03 hobbs Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.69.2.1 2003/03/24 00:55:16 msofer Exp $ */ #include "tclInt.h" #include "tclPort.h" + /* * The strings below are used to indicate what went wrong when a * variable access is denied. @@ -55,7 +56,7 @@ static void DisposeTraceResult _ANSI_ARGS_((int flags, static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, CONST char *otherP2, CONST int otherFlags, - CONST char *myName, CONST int myFlags, int index)); + CONST char *myName, int myFlags, int index)); static Var * NewVar _ANSI_ARGS_((void)); static ArraySearch * ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, @@ -596,6 +597,16 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, } /* + * This flag bit should not interfere with TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, + * or TCL_LEAVE_ERR_MSG; it signals that the variable lookup is performed for + * upvar (or similar) purposes, with slightly different rules: + * - Bug #696893 - variable is either proc-local or in the current + * namespace; never follow the second (global) resolution path + * - Bug #631741 - do not use special namespace or interp resolvers + */ +#define LOOKUP_FOR_UPVAR 0x400 + +/* *---------------------------------------------------------------------- * * TclLookupSimpleVar -- @@ -642,7 +653,8 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) CONST char *varName; /* This is a simple variable name that could * representa scalar or an array. */ int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * and TCL_LEAVE_ERR_MSG bits matter. */ + * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits + * matter. */ CONST int create; /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return * error if it doesn't exist. */ @@ -669,19 +681,21 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) varNsPtr = NULL; /* set non-NULL if a nonlocal variable */ *indexPtr = -3; + if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) { + cxtNsPtr = iPtr->globalNsPtr; + } else { + cxtNsPtr = iPtr->varFramePtr->nsPtr; + } + /* * If this namespace has a variable resolver, then give it first * crack at the variable resolution. It may return a Tcl_Var * value, it may signal to continue onward, or it may signal * an error. */ - if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) { - cxtNsPtr = iPtr->globalNsPtr; - } else { - cxtNsPtr = iPtr->varFramePtr->nsPtr; - } - if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) + && !(flags & LOOKUP_FOR_UPVAR)) { resPtr = iPtr->resolverPtr; if (cxtNsPtr->varResProc) { @@ -736,10 +750,15 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) || ((*varName == ':') && (*(varName+1) == ':')); if (lookGlobal) { *indexPtr = -1; - flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; - } else if (flags & TCL_NAMESPACE_ONLY) { - *indexPtr = -2; - } + flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR); + } else { + if (flags & LOOKUP_FOR_UPVAR) { + flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR; + } + if (flags & TCL_NAMESPACE_ONLY) { + *indexPtr = -2; + } + } /* * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, @@ -3458,7 +3477,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, * indicates scope of "other" variable. */ CONST char *myName; /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ - CONST int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of myName. */ int index; /* If the variable to be linked is an indexed * scalar, this is its index. Otherwise, -1. */ @@ -3490,7 +3509,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, if (index >= 0) { if (!varFramePtr->isProcCallFrame) { - panic("ObjMakeUpVar called with an index outside from a proc.\n"); + panic("ObjMakeUpvar called with an index outside from a proc.\n"); } varPtr = &(varFramePtr->compiledLocals[index]); } else { @@ -3513,11 +3532,16 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, } /* - * Lookup and eventually create the new variable. + * Lookup and eventually create the new variable. Set the flag bit + * LOOKUP_FOR_UPVAR to indicate the special resolution rules for + * upvar purposes: + * - Bug #696893 - variable is either proc-local or in the current + * namespace; never follow the second (global) resolution path + * - Bug #631741 - do not use special namespace or interp resolvers */ - varPtr = TclLookupSimpleVar(interp, myName, myFlags, /*create*/ 1, - &errMsg, &index); + varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), + /* create */ 1, &errMsg, &index); if (varPtr == NULL) { VarErrMsg(interp, myName, NULL, "create", errMsg); return TCL_ERROR; diff --git a/tests/var.test b/tests/var.test index 93b44f2..c8e57d8 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.20 2002/10/17 17:41:45 dgp Exp $ +# RCS: @(#) $Id: var.test,v 1.20.2.1 2003/03/24 00:55:16 msofer Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -262,6 +262,16 @@ test var-3.9 {MakeUpvar, my var has invalid ns name} { set aaaaa 789789 list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg } {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}} +test var-3.10 {MakeUpvar, } { + namespace eval {} { + set bar 0 + namespace eval foo upvar bar bar + set foo::bar 1 + catch {list $bar $foo::bar} msg + unset ::aaaaa + set msg + } +} {1 1} if {[info commands testgetvarfullname] != {}} { test var-4.1 {Tcl_GetVariableName, global variable} { -- cgit v0.12 From 322b25e28bcd49ab5c3e5473640ea10851cb82a6 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Mar 2003 16:32:20 +0000 Subject: typo corrections in ARGUMENTS --- doc/CrtMathFnc.3 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 index 69aca3d..77bd681 100644 --- a/doc/CrtMathFnc.3 +++ b/doc/CrtMathFnc.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: CrtMathFnc.3,v 1.5 2001/05/30 08:57:05 dkf Exp $ +'\" RCS: @(#) $Id: CrtMathFnc.3,v 1.5.14.1 2003/03/26 16:32:20 dgp Exp $ '\" .so man.macros .TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" @@ -46,11 +46,11 @@ Arbitrary one-word value to pass to \fIproc\fR when it is invoked. .AP int *numArgsPtr out Points to a variable that will be set to contain the number of arguments to the function. -.AP Tcl_ValueType *argTypesPtr out +.AP Tcl_ValueType **argTypesPtr out Points to a variable that will be set to contain a pointer to an array giving the permissible types for each argument to the function which will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc *procPtr out +.AP Tcl_MathProc **procPtr out Points to a variable that will be set to contain a pointer to the implementation code for the function (or NULL if the function is implemented directly in bytecode.) -- cgit v0.12 From 91ac1eea47d9605e024aa917384ee0ae77ae5448 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Mar 2003 22:56:07 +0000 Subject: * library/tcltest/tcltest.tcl: Added reporting during [configure -debug 1] operations to warn about multiple uses of the same test name. [FR 576693] Replaced [regexp] and [regsub] with [string map] where possible. Thanks to David Welton. [Bugs 667456,667558] * library/tcltest/pkgIndex.tcl: Bumped to tcltest 2.2.3 * tests/msgcat.test (msgcat-2.2.1): changed test name to avoid duplication. [Bug 710356] --- ChangeLog | 16 ++++++++++++++++ library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 24 ++++++++++++++---------- tests/msgcat.test | 4 ++-- 4 files changed, 33 insertions(+), 13 deletions(-) diff --git a/ChangeLog b/ChangeLog index 12fbcc3..260ec1b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +2003-03-26 Don Porter + + * library/tcltest/tcltest.tcl: Added reporting during + [configure -debug 1] operations to warn about multiple uses of + the same test name. [FR 576693] Replaced [regexp] and [regsub] + with [string map] where possible. Thanks to David Welton. + [Bugs 667456,667558] + * library/tcltest/pkgIndex.tcl: Bumped to tcltest 2.2.3 + + * tests/msgcat.test (msgcat-2.2.1): changed test name to avoid + duplication. [Bug 710356] + + * unix/dltest/pkg?.c: Changed all Tcl_InitStubs calls to pass + argument exact = 0, so that rebuilds are not required when Tcl + bumps to a new version. [Bug 701926] + 2003-03-24 Miguel Sofer * generic/tclVar.c: diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 345740a..b91babd 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.3]} {return} -package ifneeded tcltest 2.2.2 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.2.3 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 7d119c7..4b7bf67 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.78 2003/02/17 19:12:06 dgp Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.78.2.1 2003/03/26 22:56:09 dgp Exp $ package require Tcl 8.3 ;# uses [glob -directory] namespace eval tcltest { @@ -24,7 +24,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.2.2 + variable Version 2.2.3 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1842,6 +1842,13 @@ proc tcltest::test {name description args} { variable testLevel variable coreModTime DebugPuts 3 "test $name $args" + DebugDo 1 { + variable TestNames + catch { + puts "test name '$name' re-used; prior use in $TestNames($name)" + } + set TestNames($name) [info script] + } FillFilesExisted incr testLevel @@ -1912,11 +1919,9 @@ proc tcltest::test {name description args} { } # Replace symbolic valies supplied for -returnCodes - regsub -nocase normal $returnCodes 0 returnCodes - regsub -nocase error $returnCodes 1 returnCodes - regsub -nocase return $returnCodes 2 returnCodes - regsub -nocase break $returnCodes 3 returnCodes - regsub -nocase continue $returnCodes 4 returnCodes + foreach {strcode numcode} {normal 0 error 1 return 2 break 3 continue 4} { + set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes] + } } else { # This is parsing for the old test command format; it is here # for backward compatibility. @@ -2882,9 +2887,8 @@ proc tcltest::restoreState {} { proc tcltest::normalizeMsg {msg} { regsub "\n$" [string tolower $msg] "" msg - regsub -all "\n\n" $msg "\n" msg - regsub -all "\n\}" $msg "\}" msg - return $msg + set msg [string map [list "\n\n" "\n"] $msg] + return [string map [list "\n\}" "\}"] $msg] } # tcltest::makeFile -- diff --git a/tests/msgcat.test b/tests/msgcat.test index 2ea01cd..216e2e7 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,7 +12,7 @@ # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. # -# RCS: @(#) $Id: msgcat.test,v 1.11 2002/06/17 05:37:39 dgp Exp $ +# RCS: @(#) $Id: msgcat.test,v 1.11.2.1 2003/03/26 22:56:09 dgp Exp $ package require Tcl 8.2 if {[catch {package require tcltest 2}]} { @@ -175,7 +175,7 @@ namespace eval ::msgcat::test { namespace eval :: ::msgcat::mcset foo_BAR text3 } {text3} - test msgcat-2.2 {mcset, namespace overlap} { + test msgcat-2.2.1 {mcset, namespace overlap} { namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz} } {con1baz} -- cgit v0.12 From 6e56c993442b5f7ba73398bc98031f24ef5bb75c Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Mar 2003 23:51:20 +0000 Subject: update docs for latest change --- ChangeLog | 1 + doc/tcltest.n | 9 +++------ 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 260ec1b..7bed17a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,6 @@ 2003-03-26 Don Porter + * doc/tcltest.n: * library/tcltest/tcltest.tcl: Added reporting during [configure -debug 1] operations to warn about multiple uses of the same test name. [FR 576693] Replaced [regexp] and [regsub] diff --git a/doc/tcltest.n b/doc/tcltest.n index 4693ca6..86af612 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -8,7 +8,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tcltest.n,v 1.38.2.1 2003/03/08 21:43:49 dgp Exp $ +'\" RCS: @(#) $Id: tcltest.n,v 1.38.2.2 2003/03/26 23:51:25 dgp Exp $ '\" .so man.macros .TH "tcltest" n 2.2 tcltest "Tcl Bundled Packages" @@ -18,7 +18,7 @@ tcltest \- Test harness support code and utilities .SH SYNOPSIS .nf -\fBpackage require tcltest ?2.2?\fR +\fBpackage require tcltest ?2.2.3?\fR .sp \fBtcltest::test \fIname description ?option value ...?\fR \fBtcltest::test \fIname description ?constraints? body result\fR @@ -32,12 +32,10 @@ tcltest \- Test harness support code and utilities \fBtcltest::cleanupTests \fI?runningMultipleTests?\fR \fBtcltest::runAllTests\fR .sp -.VS 2.1 \fBtcltest::configure\fR \fBtcltest::configure \fIoption\fR \fBtcltest::configure \fIoption value ?option value ...?\fR \fBtcltest::customMatch \fImode command\fR -.VE \fBtcltest::testConstraint \fIconstraint ?value?\fR \fBtcltest::outputChannel \fI?channelID?\fR \fBtcltest::errorChannel \fI?channelID?\fR @@ -200,7 +198,6 @@ the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR below for a complete description of the many variations possible with [\fBrunAllTests\fR]. .SH "CONFIGURATION COMMANDS" -.VS .TP \fBconfigure\fR Returns the list of configurable options supported by \fBtcltest\fR. @@ -238,7 +235,6 @@ is evaluated in the global namespace. The completed script is expected to return a boolean value indicating whether or not the results match. The built-in matching modes of [\fBtest\fR] are \fBexact\fR, \fBglob\fR, and \fBregexp\fR. -.VE .TP \fBtestConstraint \fIconstraint ?boolean?\fR Sets or returns the boolean value associated with the named \fIconstraint\fR. @@ -754,6 +750,7 @@ doesn't match any of the tests that were specified using by [\fBconfigure -match\fR] (userSpecifiedNonMatch) or matches any of the tests specified by [\fBconfigure -skip\fR] (userSpecifiedSkip). Also print warnings about possible lack of cleanup or balance in test files. +Also print warnings about any re-use of test names. .IP 2 Display the flag array parsed by the command line processor, the contents of the ::env array, and all user-defined variables that exist -- cgit v0.12 From 321344b6749b9c463fc51fb58f8357cb9e53ede3 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 27 Mar 2003 13:10:46 +0000 Subject: Removed test number dups [Bugs 710322, 710327, 710349, 710363] --- ChangeLog | 12 +++++++++++ tests/foreach.test | 36 +++++++++++---------------------- tests/format.test | 24 +++++++++++----------- tests/if-old.test | 22 +++++---------------- tests/incr-old.test | 16 ++------------- tests/info.test | 10 +++++----- tests/list.test | 57 +++++++++++++++++++---------------------------------- tests/lsearch.test | 22 ++++++++++----------- tests/trace.test | 25 +++++++++++------------ tests/utf.test | 19 +++--------------- 10 files changed, 94 insertions(+), 149 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7bed17a..63bca66 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2003-03-27 Donal K. Fellows + + * tests/utf.test: Altered test numers to eliminate duplicates. + * tests/trace.test: [Bugs 710322, 710327, 710349, 710363] + * tests/lsearch.test: + * tests/list.test: + * tests/info.test: + * tests/incr-old.test: + * tests/if-old.test: + * tests/format.test: + * tests/foreach.test: + 2003-03-26 Don Porter * doc/tcltest.n: diff --git a/tests/foreach.test b/tests/foreach.test index fa5b3ea..0ab6340 100644 --- a/tests/foreach.test +++ b/tests/foreach.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: foreach.test,v 1.8 2001/09/19 18:17:54 hobbs Exp $ +# RCS: @(#) $Id: foreach.test,v 1.8.8.1 2003/03/27 13:11:01 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -171,8 +171,8 @@ test foreach-4.1 {noncompiled foreach and shared variable or value list objects # Check "continue". -test foreach-4.1 {continue tests} {catch continue} 4 -test foreach-4.2 {continue tests} { +test foreach-5.1 {continue tests} {catch continue} 4 +test foreach-5.2 {continue tests} { set a {} foreach i {a b c d} { if {[string compare $i "b"] == 0} continue @@ -180,7 +180,7 @@ test foreach-4.2 {continue tests} { } set a } {a c d} -test foreach-4.3 {continue tests} { +test foreach-5.3 {continue tests} { set a {} foreach i {a b c d} { if {[string compare $i "b"] != 0} continue @@ -188,16 +188,16 @@ test foreach-4.3 {continue tests} { } set a } {b} -test foreach-4.4 {continue tests} {catch {continue foo} msg} 1 -test foreach-4.5 {continue tests} { +test foreach-5.4 {continue tests} {catch {continue foo} msg} 1 +test foreach-5.5 {continue tests} { catch {continue foo} msg set msg } {wrong # args: should be "continue"} # Check "break". -test foreach-5.1 {break tests} {catch break} 3 -test foreach-5.2 {break tests} { +test foreach-6.1 {break tests} {catch break} 3 +test foreach-6.2 {break tests} { set a {} foreach i {a b c d} { if {[string compare $i "c"] == 0} break @@ -205,13 +205,13 @@ test foreach-5.2 {break tests} { } set a } {a b} -test foreach-5.3 {break tests} {catch {break foo} msg} 1 -test foreach-5.4 {break tests} { +test foreach-6.3 {break tests} {catch {break foo} msg} 1 +test foreach-6.4 {break tests} { catch {break foo} msg set msg } {wrong # args: should be "break"} # Check for bug #406709 -test foreach-5.5 {break tests} { +test foreach-6.5 {break tests} { proc a {} { set a 1 foreach b b {list [concat a; break]; incr a} @@ -222,7 +222,7 @@ test foreach-5.5 {break tests} { # Test for incorrect "double evaluation" semantics -test foreach-6.1 {delayed substitution of body} { +test foreach-7.1 {delayed substitution of body} { proc foo {} { set a 0 foreach a [list 1 2 3] " @@ -238,15 +238,3 @@ catch {unset a} catch {unset x} ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/format.test b/tests/format.test index 423c476..909c993 100644 --- a/tests/format.test +++ b/tests/format.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: format.test,v 1.11.2.2 2003/03/14 23:19:45 dkf Exp $ +# RCS: @(#) $Id: format.test,v 1.11.2.3 2003/03/27 13:11:11 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -84,37 +84,37 @@ test format-2.5 {string formatting, embedded nulls} { test format-2.6 {string formatting, international chars} { format "%10s" abc\ufeffdef } " abc\ufeffdef" -test format-2.6 {string formatting, international chars} { +test format-2.7 {string formatting, international chars} { format "%.5s" abc\ufeffdef } "abc\ufeffd" -test format-2.7 {string formatting, international chars} { +test format-2.8 {string formatting, international chars} { format "foo\ufeffbar%s" baz } "foo\ufeffbarbaz" -test format-2.8 {string formatting, width} { +test format-2.9 {string formatting, width} { format "a%5sa" f } "a fa" -test format-2.8 {string formatting, width} { +test format-2.10 {string formatting, width} { format "a%-5sa" f } "af a" -test format-2.8 {string formatting, width} { +test format-2.11 {string formatting, width} { format "a%2sa" foo } "afooa" -test format-2.8 {string formatting, width} { +test format-2.12 {string formatting, width} { format "a%0sa" foo } "afooa" -test format-2.8 {string formatting, precision} { +test format-2.13 {string formatting, precision} { format "a%.2sa" foobarbaz } "afoa" -test format-2.8 {string formatting, precision} { +test format-2.14 {string formatting, precision} { format "a%.sa" foobarbaz } "aa" -test format-2.8 {string formatting, precision} { +test format-2.15 {string formatting, precision} { list [catch {format "a%.-2sa" foobarbaz} msg] $msg } {1 {bad field specifier "-"}} -test format-2.8 {string formatting, width and precision} { +test format-2.16 {string formatting, width and precision} { format "a%5.2sa" foobarbaz } "a foa" -test format-2.8 {string formatting, width and precision} { +test format-2.17 {string formatting, width and precision} { format "a%5.7sa" foobarbaz } "afoobarba" diff --git a/tests/if-old.test b/tests/if-old.test index f0b977b..8c85f0a 100644 --- a/tests/if-old.test +++ b/tests/if-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: if-old.test,v 1.5 2000/04/10 17:18:59 ericm Exp $ +# RCS: @(#) $Id: if-old.test,v 1.5.24.1 2003/03/27 13:11:12 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -45,22 +45,22 @@ test if-old-1.5 {taking proper branch} { if 0 {set a 1} else {} set a } {} -test if-old-1.5 {taking proper branch} { +test if-old-1.6 {taking proper branch} { set a {} if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4} set a } {2} -test if-old-1.6 {taking proper branch} { +test if-old-1.7 {taking proper branch} { set a {} if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4} set a } {3} -test if-old-1.7 {taking proper branch} { +test if-old-1.8 {taking proper branch} { set a {} if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4} set a } {4} -test if-old-1.8 {taking proper branch, multiline test expr} { +test if-old-1.9 {taking proper branch, multiline test expr} { set a {} if {($tcl_platform(platform) != "foobar1") && \ ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4} @@ -162,15 +162,3 @@ test if-old-4.11 {error conditions} { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/incr-old.test b/tests/incr-old.test index 1c78b82..566eafd 100644 --- a/tests/incr-old.test +++ b/tests/incr-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: incr-old.test,v 1.6 2003/02/06 22:44:58 mdejong Exp $ +# RCS: @(#) $Id: incr-old.test,v 1.6.2.1 2003/03/27 13:11:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -34,7 +34,7 @@ test incr-old-1.3 {basic incr operation} { set x " -106" list [incr x 1] $x } {-105 -105} -test incr-old-1.3 {basic incr operation} { +test incr-old-1.4 {basic incr operation} { set x " +106" list [incr x 1] $x } {107 107} @@ -94,15 +94,3 @@ test incr-old-2.10 {incr errors} { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/info.test b/tests/info.test index 4f87e99..715f9ae 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.24 2002/07/01 07:52:03 dgp Exp $ +# RCS: @(#) $Id: info.test,v 1.24.2.1 2003/03/27 13:11:14 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -162,16 +162,16 @@ test info-5.1 {info complete option} { test info-5.2 {info complete option} { info complete abc } 1 -test info-5.2 {info complete option} { +test info-5.3 {info complete option} { info complete "\{abcd " } 0 -test info-5.3 {info complete option} { +test info-5.4 {info complete option} { info complete {# Comment should be complete command} } 1 -test info-5.4 {info complete option} { +test info-5.5 {info complete option} { info complete {[a [b] } } 0 -test info-5.5 {info complete option} { +test info-5.6 {info complete option} { info complete {[a [b]} } 0 diff --git a/tests/list.test b/tests/list.test index e20023e..da61f10 100644 --- a/tests/list.test +++ b/tests/list.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: list.test,v 1.5 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: list.test,v 1.5.24.1 2003/03/27 13:11:15 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -48,33 +48,28 @@ test list-1.24 {basic tests} {list} {} # For the next round of tests create a list and then pick it apart # with "index" to make sure that we get back exactly what went in. -test list-2.1 {placeholder} { -} {} -set num 1 -proc lcheck {a b c} { +set num 0 +proc lcheck {testid a b c} { global num d set d [list $a $b $c] -; test list-2.$num {what goes in must come out} {lindex $d 0} $a - set num [expr $num+1] -; test list-2.$num {what goes in must come out} {lindex $d 1} $b - set num [expr $num+1] -; test list-2.$num {what goes in must come out} {lindex $d 2} $c - set num [expr $num+1] + test ${testid}-0 {what goes in must come out} {lindex $d 0} $a + test ${testid}-1 {what goes in must come out} {lindex $d 1} $b + test ${testid}-2 {what goes in must come out} {lindex $d 2} $c } -lcheck a b c -lcheck "a b" c\td e\nf -lcheck {{a b}} {} { } -lcheck \$ \$ab ab\$ -lcheck \; \;ab ab\; -lcheck \[ \[ab ab\[ -lcheck \\ \\ab ab\\ -lcheck {"} {"ab} {ab"} -lcheck {a b} { ab} {ab } -lcheck a{ a{b \{ab -lcheck a} a}b }ab -lcheck a\\} {a \}b} {a \{c} -lcheck xyz \\ 1\\\n2 -lcheck "{ab}\\" "{ab}xy" abc +lcheck list-2.1 a b c +lcheck list-2.2 "a b" c\td e\nf +lcheck list-2.3 {{a b}} {} { } +lcheck list-2.4 \$ \$ab ab\$ +lcheck list-2.5 \; \;ab ab\; +lcheck list-2.6 \[ \[ab ab\[ +lcheck list-2.7 \\ \\ab ab\\ +lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting! +lcheck list-2.9 {a b} { ab} {ab } +lcheck list-2.10 a{ a{b \{ab +lcheck list-2.11 a} a}b }ab +lcheck list-2.12 a\\} {a \}b} {a \{c} +lcheck list-2.13 xyz \\ 1\\\n2 +lcheck list-2.14 "{ab}\\" "{ab}xy" abc concat {} @@ -113,15 +108,3 @@ test list-3.1 {SetListFromAny and lrange/concat results} { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/lsearch.test b/tests/lsearch.test index 1beaaab..96ff415 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lsearch.test,v 1.10 2003/02/27 16:02:00 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.10.2.1 2003/03/27 13:11:16 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -315,37 +315,37 @@ test lsearch-13.2 {search for all matches} { lsearch -all {a b a c a d} a } {0 2 4} -test lsearch-13.1 {combinations: -all and -inline} { +test lsearch-14.1 {combinations: -all and -inline} { lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a* } {a1 a3 a5} -test lsearch-13.2 {combinations: -all, -inline and -not} { +test lsearch-14.2 {combinations: -all, -inline and -not} { lsearch -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {b2 c4 d6} -test lsearch-13.3 {combinations: -all and -not} { +test lsearch-14.3 {combinations: -all and -not} { lsearch -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {1 3 5} -test lsearch-13.4 {combinations: -inline and -not} { +test lsearch-14.4 {combinations: -inline and -not} { lsearch -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {b2} -test lsearch-13.5 {combinations: -start, -all and -inline} { +test lsearch-14.5 {combinations: -start, -all and -inline} { lsearch -start 2 -all -inline -glob {a1 b2 a3 c4 a5 d6} a* } {a3 a5} -test lsearch-13.6 {combinations: -start, -all, -inline and -not} { +test lsearch-14.6 {combinations: -start, -all, -inline and -not} { lsearch -start 2 -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4 d6} -test lsearch-13.7 {combinations: -start, -all and -not} { +test lsearch-14.7 {combinations: -start, -all and -not} { lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a* } {3 5} -test lsearch-13.8 {combinations: -start, -inline and -not} { +test lsearch-14.8 {combinations: -start, -inline and -not} { lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a* } {c4} -test lsearch-14.1 {make sure no shimmering occurs} { +test lsearch-15.1 {make sure no shimmering occurs} { set x [expr int(sin(0))] lsearch -start $x $x $x } 0 -test lsearch-15.1 {lsearch -regexp shared object} { +test lsearch-16.1 {lsearch -regexp shared object} { set str a lsearch -regexp $str $str } 0 diff --git a/tests/trace.test b/tests/trace.test index 2da4a9f..cedb7ba 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.26 2003/02/03 20:16:54 kennykb Exp $ +# RCS: @(#) $Id: trace.test,v 1.26.2.1 2003/03/27 13:11:17 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -828,13 +828,13 @@ test trace-14.11 {trace command, "trace variable" errors} { } [list 1 "bad operations \"y\": should be one or more of rwua"] -test trace-14.9 {trace command ("remove variable" option)} { +test trace-14.12 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write traceProc trace remove variable x write traceProc } {} -test trace-14.10 {trace command ("remove variable" option)} { +test trace-14.13 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write traceProc @@ -842,7 +842,7 @@ test trace-14.10 {trace command ("remove variable" option)} { set x 12345 set info } {} -test trace-14.11 {trace command ("remove variable" option)} { +test trace-14.14 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write {traceTag 1} @@ -857,7 +857,7 @@ test trace-14.11 {trace command ("remove variable" option)} { set x gorp set info } {2 x {} write 1 2 1 2} -test trace-14.12 {trace command ("remove variable" option)} { +test trace-14.15 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write {traceTag 1} @@ -865,27 +865,27 @@ test trace-14.12 {trace command ("remove variable" option)} { set x 12345 set info } {1} -test trace-14.15 {trace command ("info variable" option)} { +test trace-14.16 {trace command ("info variable" option)} { catch {unset x} trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} trace info variable x } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}} -test trace-14.16 {trace command ("info variable" option)} { +test trace-14.17 {trace command ("info variable" option)} { catch {unset x} trace info variable x } {} -test trace-14.17 {trace command ("info variable" option)} { +test trace-14.18 {trace command ("info variable" option)} { catch {unset x} trace info variable x(0) } {} -test trace-14.18 {trace command ("info variable" option)} { +test trace-14.19 {trace command ("info variable" option)} { catch {unset x} set x 44 trace info variable x(0) } {} -test trace-14.19 {trace command ("info variable" option)} { +test trace-14.20 {trace command ("info variable" option)} { catch {unset x} set x 44 trace add variable x write {traceTag 1} @@ -1165,12 +1165,12 @@ test trace-18.2 {namespace delete / trace vdelete combo} { catch {unset x} catch {unset y} -test trace-18.2 {trace add command (command existence)} { +test trace-18.3 {trace add command (command existence)} { # Just in case! catch {rename nosuchname ""} list [catch {trace add command nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchname"}} -test trace-18.3 {trace add command (command existence in ns)} { +test trace-18.4 {trace add command (command existence in ns)} { list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchns::nosuchname"}} @@ -2105,4 +2105,3 @@ catch {unset info} # cleanup ::tcltest::cleanupTests return - diff --git a/tests/utf.test b/tests/utf.test index 9929482..56e1b5f 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: utf.test,v 1.8.14.1 2003/03/06 23:24:18 dgp Exp $ +# RCS: @(#) $Id: utf.test,v 1.8.14.2 2003/03/27 13:11:18 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -290,11 +290,11 @@ test utf-24.2 {unicode digit char in regc_locale.c} { list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040] } {1 1} -test utf-24.1 {TclUniCharIsSpace} { +test utf-24.3 {TclUniCharIsSpace} { # this returns 1 with Unicode 3 compliance string is space \u1680 } {1} -test utf-24.2 {unicode space char in regc_locale.c} { +test utf-24.4 {unicode space char in regc_locale.c} { # this returns 1 with Unicode 3 compliance list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680] } {1 1} @@ -336,16 +336,3 @@ test utf-25.4 {Tcl_UniCharNcasecmp} teststringobj { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - -- cgit v0.12 From 448259ec5133371d0c4afda31bd093b8122b537b Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 27 Mar 2003 13:49:21 +0000 Subject: More elimination of dup test numbers [Bugs 710365, 710369] --- ChangeLog | 5 +++++ tests/expr-old.test | 14 +++++++------- tests/expr.test | 6 +++--- tests/parse.test | 4 ++-- tests/parseOld.test | 20 +++++--------------- 5 files changed, 22 insertions(+), 27 deletions(-) diff --git a/ChangeLog b/ChangeLog index 63bca66..cb9eb04 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2003-03-27 Donal K. Fellows + * tests/parseOld.test: Altered test numers to eliminate duplicates. + * tests/parse.test: [Bugs 710365, 710369] + * tests/expr-old.test: + * tests/expr.test: + * tests/utf.test: Altered test numers to eliminate duplicates. * tests/trace.test: [Bugs 710322, 710327, 710349, 710363] * tests/lsearch.test: diff --git a/tests/expr-old.test b/tests/expr-old.test index 32f737a..17d32d2 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr-old.test,v 1.16 2002/08/05 03:24:41 dgp Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.16.2.1 2003/03/27 13:49:22 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -194,16 +194,16 @@ test expr-old-4.23 {string operators} {expr {"" eq "abd"}} 0 test expr-old-4.24 {string operators} {expr {"" eq ""}} 1 test expr-old-4.25 {string operators} {expr {"abd" ne ""}} 1 test expr-old-4.26 {string operators} {expr {"" ne ""}} 0 -test expr-old-4.26 {string operators} {expr {"longerstring" eq "shorter"}} 0 -test expr-old-4.26 {string operators} {expr {"longerstring" ne "shorter"}} 1 +test expr-old-4.27 {string operators} {expr {"longerstring" eq "shorter"}} 0 +test expr-old-4.28 {string operators} {expr {"longerstring" ne "shorter"}} 1 # The following tests are non-portable because on some systems "+" # and "-" can be parsed as numbers. -test expr-old-4.19 {string operators} {nonPortable} {expr {"0" == "+"}} 0 -test expr-old-4.20 {string operators} {nonPortable} {expr {"0" == "-"}} 0 -test expr-old-4.21 {string operators} {expr {1?"foo":"bar"}} foo -test expr-old-4.22 {string operators} {expr {0?"foo":"bar"}} bar +test expr-old-4.29 {string operators} {nonPortable} {expr {"0" == "+"}} 0 +test expr-old-4.30 {string operators} {nonPortable} {expr {"0" == "-"}} 0 +test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo +test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar # Operators that aren't legal on string operands. diff --git a/tests/expr.test b/tests/expr.test index c06080f..6ef1c41 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.17 2002/07/31 09:33:45 dkf Exp $ +# RCS: @(#) $Id: expr.test,v 1.17.2.1 2003/03/27 13:49:22 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -297,8 +297,8 @@ test expr-8.11 {CompileEqualityExpr: error compiling equality arm} { catch {expr 2!=x} msg set msg } {syntax error in expression "2!=x": variable references require preceding $} -test expr-8.14 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 -test expr-8.14 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1 +test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 +test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1 test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0 test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1 diff --git a/tests/parse.test b/tests/parse.test index 95330be..8007fc2 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parse.test,v 1.11 2003/02/16 01:36:32 msofer Exp $ +# RCS: @(#) $Id: parse.test,v 1.11.2.1 2003/03/27 13:49:22 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -731,7 +731,7 @@ test parse-15.57 {CommandComplete procedure} { test parse-15.58 {CommandComplete procedure, memory leaks} { info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" } 1 -test parse-15.58 {CommandComplete procedure} { +test parse-15.59 {CommandComplete procedure} { # Test for Tcl Bug 684744 info complete [encoding convertfrom identity "\x00;if 1 \{"] } 0 diff --git a/tests/parseOld.test b/tests/parseOld.test index 80e6338..6be1e59 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseOld.test,v 1.11 2002/06/25 01:13:38 dgp Exp $ +# RCS: @(#) $Id: parseOld.test,v 1.11.2.1 2003/03/27 13:49:22 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -321,6 +321,7 @@ test parseOld-10.4 {syntax errors} { catch {set a "bcd} msg set msg } {missing "} +#" Emacs formatting >:^( test parseOld-10.5 {syntax errors} {catch {set a "bcd"xy} msg} 1 test parseOld-10.6 {syntax errors} { catch {set a "bcd"xy} msg @@ -419,8 +420,7 @@ set i 0 foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] { set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i] set test $test$test$test$test - set i [expr $i+1] - test parseOld-11.10 {long values} { + test parseOld-11.10-[incr i] {long values} { set j } $test } @@ -468,6 +468,7 @@ test parseOld-14.3 {TclWordEnd procedure} {testwordend} { test parseOld-14.4 {TclWordEnd procedure} {testwordend} { testwordend {"abc"} } {"} +#" Emacs formatting >:^( test parseOld-14.5 {TclWordEnd procedure} {testwordend} { testwordend {{xyz}} } \} @@ -513,6 +514,7 @@ test parseOld-14.18 {TclWordEnd procedure} {testwordend} { test parseOld-14.19 {TclWordEnd procedure} {testwordend} { testwordend \"a\000\" } {"} +#" Emacs formatting >:^( test parseOld-14.20 {TclWordEnd procedure} {testwordend} { testwordend a{\000}b } {b} @@ -542,15 +544,3 @@ test parseOld-15.5 {TclScriptEnd procedure} { set argv $savedArgv ::tcltest::cleanupTests return - - - - - - - - - - - - -- cgit v0.12 From 6f64bc5e648aeac1e18e902f794da65be949c076 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Thu, 27 Mar 2003 21:46:27 +0000 Subject: Altered test numers to eliminate duplicates, [Bugs 710313, 710320, 710352] --- ChangeLog | 7 +++++ tests/encoding.test | 4 +-- tests/proc-old.test | 4 +-- tests/set-old.test | 84 ++++++++++++++++++++++++++--------------------------- 4 files changed, 53 insertions(+), 46 deletions(-) diff --git a/ChangeLog b/ChangeLog index cb9eb04..39dc1bb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2003-03-27 Miguel Sofer + + * tests/encoding.test: + * tests/proc-old.test: + * tests/set-old.test: Altered test numers to eliminate duplicates, + [Bugs 710313, 710320, 710352] + 2003-03-27 Donal K. Fellows * tests/parseOld.test: Altered test numers to eliminate duplicates. diff --git a/tests/encoding.test b/tests/encoding.test index 2ea4463..90ce6d4 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: encoding.test,v 1.16 2003/02/21 02:40:58 hobbs Exp $ +# RCS: @(#) $Id: encoding.test,v 1.16.2.1 2003/03/27 21:46:32 msofer Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -332,7 +332,7 @@ fconfigure $fid -encoding binary puts -nonewline $fid $::iso2022encData close $fid -test encoding-23.2 {iso2022-jp escape encoding test} { +test encoding-23.1 {iso2022-jp escape encoding test} { string equal $::iso2022uniData $::iso2022uniData2 } 1 test encoding-23.2 {iso2022-jp escape encoding test} { diff --git a/tests/proc-old.test b/tests/proc-old.test index 44b55a4..680c89d 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc-old.test,v 1.9 2002/04/15 17:45:06 msofer Exp $ +# RCS: @(#) $Id: proc-old.test,v 1.9.2.1 2003/03/27 21:46:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -481,7 +481,7 @@ test proc-old-7.14 {return with special completion code} { } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} none} -test proc-old-7.14 {return with special completion code} { +test proc-old-7.15 {return with special completion code} { list [catch {return -badOption foo message} msg] $msg } {1 {bad option "-badOption": must be -code, -errorcode, or -errorinfo}} diff --git a/tests/set-old.test b/tests/set-old.test index df23cb3..c798990 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: set-old.test,v 1.16 2003/02/05 20:05:51 mdejong Exp $ +# RCS: @(#) $Id: set-old.test,v 1.16.2.1 2003/03/27 21:46:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -430,29 +430,29 @@ test set-old-8.22 {array command, names option} { set a(22) 3 list [catch {array names a 4 5} msg] $msg } {1 {bad option "4": must be -exact, -glob, or -regexp}} -test set-old-8.19 {array command, names option} { +test set-old-8.23 {array command, names option} { catch {unset a} array names a } {} -test set-old-8.23 {array command, names option} { +test set-old-8.24 {array command, names option} { catch {unset a} set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx list [catch {lsort [array names a]} msg] $msg } {0 {22 Textual_name {name with spaces}}} -test set-old-8.24 {array command, names option} { +test set-old-8.25 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; trace var a(xxx) w ignore list [catch {lsort [array names a]} msg] $msg } {0 {22 33}} -test set-old-8.25 {array command, names option} { +test set-old-8.26 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; trace var a(xxx) w ignore set a(xxx) value list [catch {lsort [array names a]} msg] $msg } {0 {22 33 xxx}} -test set-old-8.26 {array command, names option} { +test set-old-8.27 {array command, names option} { catch {unset a} set a(axy) 3 set a(bxy) 44 @@ -460,7 +460,7 @@ test set-old-8.26 {array command, names option} { set a(xxx) value list [lsort [array names a *xy]] [lsort [array names a]] } {{axy bxy} {axy bxy no xxx}} -test set-old-8.27 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} { +test set-old-8.28 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array names a] @@ -469,14 +469,14 @@ test set-old-8.27 {array command, names option, array doesn't exist yet but has } list [catch {foo 1} msg] $msg } {0 {}} -test set-old-8.28 {array command, nextelement option} { +test set-old-8.29 {array command, nextelement option} { list [catch {array nextelement a} msg] $msg } {1 {wrong # args: should be "array nextelement arrayName searchId"}} -test set-old-8.29 {array command, nextelement option} { +test set-old-8.30 {array command, nextelement option} { catch {unset a} list [catch {array nextelement a b} msg] $msg } {1 {"a" isn't an array}} -test set-old-8.30 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} { +test set-old-8.31 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array nextelement a b] @@ -485,27 +485,27 @@ test set-old-8.30 {array command, nextelement option, array doesn't exist yet bu } list [catch {foo 1} msg] $msg } {1 {"a" isn't an array}} -test set-old-8.31 {array command, set option} { +test set-old-8.32 {array command, set option} { list [catch {array set a} msg] $msg } {1 {wrong # args: should be "array set arrayName list"}} -test set-old-8.32 {array command, set option} { +test set-old-8.33 {array command, set option} { list [catch {array set a 1 2} msg] $msg } {1 {wrong # args: should be "array set arrayName list"}} -test set-old-8.33 {array command, set option} { +test set-old-8.34 {array command, set option} { list [catch {array set a "a \{ c"} msg] $msg } {1 {unmatched open brace in list}} -test set-old-8.34 {array command, set option} { +test set-old-8.35 {array command, set option} { catch {unset a} set a 44 list [catch {array set a {a b c d}} msg] $msg } {1 {can't set "a(a)": variable isn't array}} -test set-old-8.35 {array command, set option} { +test set-old-8.36 {array command, set option} { catch {unset a} set a(xx) yy array set a {b c d e} lsort [array get a] } {b c d e xx yy} -test set-old-8.36 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} { +test set-old-8.37 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array set a {x 0}] @@ -514,72 +514,72 @@ test set-old-8.36 {array command, set option, array doesn't exist yet but has co } list [catch {foo 1} msg] $msg } {0 {}} -test set-old-8.37 {array command, set option} { +test set-old-8.38 {array command, set option} { catch {unset aVaRnAmE} array set aVaRnAmE {} list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg } {1 1 {can't read "aVaRnAmE": variable is array}} -test set-old-8.37.1 {array command, set scalar} { +test set-old-8.38.1 {array command, set scalar} { catch {unset aVaRnAmE} set aVaRnAmE 1 list [catch {array set aVaRnAmE {}} msg] $msg } {1 {can't array set "aVaRnAmE": variable isn't array}} -test set-old-8.37.2 {array command, set alias} { +test set-old-8.38.2 {array command, set alias} { catch {unset aVaRnAmE} upvar 0 aVaRnAmE anAliAs array set anAliAs {} list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg } {1 1 {can't read "anAliAs": variable is array}} -test set-old-8.37.3 {array command, set element alias} { +test set-old-8.38.3 {array command, set element alias} { catch {unset aVaRnAmE} list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \ [catch {array set elemAliAs {}} msg] $msg } {0 1 {can't array set "elemAliAs": variable isn't array}} -test set-old-8.37.4 {array command, empty set with populated array} { +test set-old-8.38.4 {array command, empty set with populated array} { catch {unset aVaRnAmE} array set aVaRnAmE [list e1 v1 e2 v2] array set aVaRnAmE {} array set aVaRnAmE [list e3 v3] list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg } {{e1 e2 e3} 0 v2} -test set-old-8.37.5 {array command, set with non-existent namespace} { +test set-old-8.38.5 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var {}} msg] $msg } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} -test set-old-8.37.6 {array command, set with non-existent namespace} { +test set-old-8.38.6 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var {a b}} msg] $msg } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}} -test set-old-8.37.7 {array command, set with non-existent namespace} { +test set-old-8.38.7 {array command, set with non-existent namespace} { list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg } {1 {can't set "bogusnamespace::var(0)": variable isn't array}} -test set-old-8.38 {array command, size option} { +test set-old-8.39 {array command, size option} { catch {unset a} array size a } {0} -test set-old-8.39 {array command, size option} { +test set-old-8.40 {array command, size option} { list [catch {array size a 4} msg] $msg } {1 {wrong # args: should be "array size arrayName"}} -test set-old-8.40 {array command, size option} { +test set-old-8.41 {array command, size option} { catch {unset a} array size a } {0} -test set-old-8.41 {array command, size option} { +test set-old-8.42 {array command, size option} { catch {unset a} set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx list [catch {array size a} msg] $msg } {0 3} -test set-old-8.42 {array command, size option} { +test set-old-8.43 {array command, size option} { catch {unset a} set a(22) 3; set a(xx) 44; set a(y) xxx unset a(22) a(y) a(xx) list [catch {array size a} msg] $msg } {0 0} -test set-old-8.43 {array command, size option} { +test set-old-8.44 {array command, size option} { catch {unset a} set a(22) 3; trace var a(33) rwu ignore list [catch {array size a} msg] $msg } {0 1} -test set-old-8.44 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { +test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { proc foo {x} { if {$x==1} { return [array size a] @@ -588,14 +588,14 @@ test set-old-8.44 {array command, size option, array doesn't exist yet but has c } list [catch {foo 1} msg] $msg } {0 0} -test set-old-8.45 {array command, startsearch option} { +test set-old-8.46 {array command, startsearch option} { list [catch {array startsearch a b} msg] $msg } {1 {wrong # args: should be "array startsearch arrayName"}} -test set-old-8.46 {array command, startsearch option} { +test set-old-8.47 {array command, startsearch option} { catch {unset a} list [catch {array startsearch a} msg] $msg } {1 {"a" isn't an array}} -test set-old-8.47 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} { +test set-old-8.48 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} { catch {rename p ""} proc p {x} { if {$x==1} { @@ -605,7 +605,7 @@ test set-old-8.47 {array command, startsearch option, array doesn't exist yet bu } list [catch {p 1} msg] $msg } {1 {"a" isn't an array}} -test set-old-8.48 {array command, statistics option} { +test set-old-8.49 {array command, statistics option} { catch {unset a} set a(abc) 1 set a(def) 2 @@ -630,47 +630,47 @@ number of buckets with 8 entries: 0 number of buckets with 9 entries: 0 number of buckets with 10 or more entries: 0 average search distance for entry: 1.7" -test set-old-8.49 {array command, array names -exact on glob pattern} { +test set-old-8.50 {array command, array names -exact on glob pattern} { catch {unset a} set a(1*2) 1 list [catch {array names a -exact 1*2} msg] $msg } {0 1*2} -test set-old-8.48 {array command, array names -glob on glob pattern} { +test set-old-8.51 {array command, array names -glob on glob pattern} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -glob 1*2]} msg] $msg } {0 {1*2 12}} -test set-old-8.49 {array command, array names -regexp on regexp pattern} { +test set-old-8.52 {array command, array names -regexp on regexp pattern} { catch {unset a} set a(1*2) 1 set a(12) 1 set a(11) 1 list [catch {lsort [array names a -regexp ^1]} msg] $msg } {0 {1*2 11 12}} -test set-old-8.50 {array command, array names -regexp} { +test set-old-8.53 {array command, array names -regexp} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -regexp} msg] $msg } {0 -regexp} -test set-old-8.51 {array command, array names -exact} { +test set-old-8.54 {array command, array names -exact} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -exact} msg] $msg } {0 -exact} -test set-old-8.52 {array command, array names -glob} { +test set-old-8.55 {array command, array names -glob} { catch {unset a} set a(-glob) 1 set a(-regexp) 1 set a(-exact) 1 list [catch {array names a -glob} msg] $msg } {0 -glob} -test set-old-8.53 {array command, array statistics on a non-array} { +test set-old-8.56 {array command, array statistics on a non-array} { catch {unset a} list [catch {array statistics a} msg] $msg } [list 1 "\"a\" isn't an array"] -- cgit v0.12 From 68febb66350aa26c585f191960ccb474d5c75b36 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 1 Apr 2003 21:13:04 +0000 Subject: * tests/README: Direct [source] of *.test files is no longer recommended. The tests/*.test files should only be evaluated under the control of the [runAllTests] command in tests/all.tcl. --- ChangeLog | 6 ++++++ tests/README | 61 +++++++++++++++++++++++++++++++++++++++--------------------- 2 files changed, 46 insertions(+), 21 deletions(-) diff --git a/ChangeLog b/ChangeLog index 39dc1bb..aac78fb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2003-04-01 Don Porter + + * tests/README: Direct [source] of *.test files is no longer + recommended. The tests/*.test files should only be evaluated under + the control of the [runAllTests] command in tests/all.tcl. + 2003-03-27 Miguel Sofer * tests/encoding.test: diff --git a/tests/README b/tests/README index 19a8025..c9f5e3a 100644 --- a/tests/README +++ b/tests/README @@ -1,12 +1,14 @@ README -- Tcl test suite design document. -RCS: @(#) $Id: README,v 1.11 2002/08/08 14:50:51 dgp Exp $ +RCS: @(#) $Id: README,v 1.11.2.1 2003/04/01 21:13:07 dgp Exp $ Contents: --------- 1. Introduction - 2. Incompatibilities with prior Tcl versions + 2. Running tests + 3. Adding tests + 4. Incompatibilities with prior Tcl versions 1. Introduction: ---------------- @@ -18,24 +20,36 @@ file that corresponds to the file prefix. The C functions and/or Tcl commands tested by a given file are listed in the first line of the file. -You can run the tests in three ways: - - (a) type "make test" in ../unix; this will create the tcltest - executable and run all of the tests. At least "make tcltest" - must be run to create the tcltest executable for the other - options. - - (b) type "tcltest ?