From a15ea81906fdac4ed3868e9866d07a8ca4c2354c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Jul 2020 07:33:42 +0000
Subject: Backport changes in tcltest package from higher Tcl versions. Rename
(internal, undocumented) tcltest::loadIntoSlaveInterpreter into
tcltest::loadIntoChildInterpreter tcltest 2.5.1 -> 2.5.3
---
library/tcltest/pkgIndex.tcl | 2 +-
library/tcltest/tcltest.tcl | 35 +++++++++++++++++++++++------------
tests/init.test | 10 +++++-----
tests/pkg.test | 4 ++--
unix/Makefile.in | 4 ++--
win/Makefile.in | 4 ++--
6 files changed, 35 insertions(+), 24 deletions(-)
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index ca93725..a56a0d6 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.5-]} {return}
-package ifneeded tcltest 2.5.1 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.5.3 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 1394949..c894ff1 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,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.5.1
+ variable Version 2.5.3
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -811,14 +811,14 @@ namespace eval tcltest {
trace add variable Option(-errfile) write \
[namespace code {errorChannel $Option(-errfile) ;#}]
- proc loadIntoSlaveInterpreter {slave args} {
+ proc loadIntoChildInterpreter {child args} {
variable Version
- interp eval $slave [package ifneeded tcltest $Version]
- interp eval $slave "tcltest::configure {*}{$args}"
- interp alias $slave ::tcltest::ReportToMaster \
- {} ::tcltest::ReportedFromSlave
+ interp eval $child [package ifneeded tcltest $Version]
+ interp eval $child "tcltest::configure {*}{$args}"
+ interp alias $child ::tcltest::ReportToParent \
+ {} ::tcltest::ReportedFromChild
}
- proc ReportedFromSlave {total passed skipped failed because newfiles} {
+ proc ReportedFromChild {total passed skipped failed because newfiles} {
variable numTests
variable skippedBecause
variable createdNewFiles
@@ -1982,7 +1982,10 @@ proc tcltest::test {name description args} {
}
}
- # First, run the setup script
+ # First, run the setup script (or a hook if it presents):
+ if {[set cmd [namespace which -command [namespace current]::SetupTest]] ne ""} {
+ set setup [list $cmd $setup]
+ }
set processTest 1
set code [catch {uplevel 1 $setup} setupMsg]
if {$code == 1} {
@@ -2077,7 +2080,10 @@ proc tcltest::test {name description args} {
set scriptFailure 1
}
- # Always run the cleanup script
+ # Always run the cleanup script (or a hook if it presents):
+ if {[set cmd [namespace which -command [namespace current]::CleanupTest]] ne ""} {
+ set cleanup [list $cmd $cleanup]
+ }
set code [catch {uplevel 1 $cleanup} cleanupMsg]
if {$code == 1} {
set errorInfo(cleanup) $::errorInfo
@@ -2390,6 +2396,10 @@ proc tcltest::RunTest {name script} {
memory tag $name
}
+ # run the test script (or a hook if it presents):
+ if {[set cmd [namespace which -command [namespace current]::EvalTest]] ne ""} {
+ set script [list $cmd $script]
+ }
set code [catch {uplevel 1 $script} actualAnswer]
return [list $actualAnswer $code]
@@ -2452,8 +2462,8 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
set testFileName [file tail [info script]]
# Hook to handle reporting to a parent interpreter
- if {[llength [info commands [namespace current]::ReportToMaster]]} {
- ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
+ if {[llength [info commands [namespace current]::ReportToParent]]} {
+ ReportToParent $numTests(Total) $numTests(Passed) $numTests(Skipped) \
$numTests(Failed) [array get skippedBecause] \
[array get createdNewFiles]
set testSingleFile false
@@ -3097,11 +3107,12 @@ proc tcltest::removeFile {name {directory ""}} {
set fullName [file join $directory $name]
DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName"
set idx [lsearch -exact $filesMade $fullName]
- set filesMade [lreplace $filesMade $idx $idx]
if {$idx == -1} {
DebugDo 1 {
Warn "removeFile removing \"$fullName\":\n not created by makeFile"
}
+ } else {
+ set filesMade [lreplace $filesMade $idx $idx]
}
if {![file isfile $fullName]} {
DebugDo 1 {
diff --git a/tests/init.test b/tests/init.test
index d56c72d..9c81694 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -19,16 +19,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
test init-0.1 {no error on initialization phase (init.tcl)} -setup {
- interp create slave
+ interp create child
} -body {
- slave eval {
+ child eval {
list [set v [info exists ::errorInfo]] \
[if {$v} {set ::errorInfo}] \
[set v [info exists ::errorCode]] \
[if {$v} {set ::errorCode}]
}
} -cleanup {
- interp delete slave
+ interp delete child
} -result {0 {} 0 {}}
# Six cases - white box testing
@@ -68,11 +68,11 @@ test init-1.8 {auto_qualify - multiple colons 2} {
} foo
-# we use a sub interp and auto_reset and double the tests because there is 2
+# we use a child interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
+tcltest::loadIntoChildInterpreter $testInterp {*}$argv
interp eval $testInterp {
namespace import -force ::tcltest::*
auto_reset
diff --git a/tests/pkg.test b/tests/pkg.test
index 10b4732..21f898c 100644
--- a/tests/pkg.test
+++ b/tests/pkg.test
@@ -16,10 +16,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-# Do all this in a slave interp to avoid garbaging the
+# Do all this in a child interp to avoid garbaging the
# package list
set i [interp create]
-tcltest::loadIntoSlaveInterpreter $i {*}$argv
+tcltest::loadIntoChildInterpreter $i {*}$argv
interp eval $i {
namespace import -force ::tcltest::*
diff --git a/unix/Makefile.in b/unix/Makefile.in
index c20ba57..fd44f4e 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -788,8 +788,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
done;
@echo "Installing package msgcat 1.5.2 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
- @echo "Installing package tcltest 2.5.1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.1.tm;
+ @echo "Installing package tcltest 2.5.3 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.3.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
diff --git a/win/Makefile.in b/win/Makefile.in
index 63f4c15..25a919a 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -671,8 +671,8 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing package msgcat 1.5.2 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
- @echo "Installing package tcltest 2.5.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.1.tm;
+ @echo "Installing package tcltest 2.5.3 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.3.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
--
cgit v0.12
From 99d517e3cba02eeef2d49f6447db7dce60c611f6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Jul 2020 14:25:11 +0000
Subject: Use "Global" in stead of "Master" internally, where "Master" is not
used in the Master-Slave paradigm and where this makes sense.
---
generic/tclInt.h | 28 ++++++++++----------
generic/tclThread.c | 22 ++++++++--------
generic/tclThreadStorage.c | 32 +++++++++++------------
generic/tclUtil.c | 4 +--
unix/tclUnixThrd.c | 52 ++++++++++++++++++-------------------
win/tclWinThrd.c | 64 +++++++++++++++++++++++-----------------------
6 files changed, 101 insertions(+), 101 deletions(-)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index dfb3dfe..31108c7 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1804,7 +1804,7 @@ typedef struct Interp {
* of hidden commands on a per-interp
* basis. */
ClientData interpInfo; /* Information used by tclInterp.c to keep
- * track of master/slave interps on a
+ * track of parent/child interps on a
* per-interp basis. */
union {
void (*optimizer)(void *envPtr);
@@ -2082,7 +2082,7 @@ typedef struct Interp {
* (c) are accessed very often (e.g., at each command call)
*
* Note that these are the same for all interps in the same thread. They
- * just have to be initialised for the thread's master interp, slaves
+ * just have to be initialised for the thread's parent interp, children
* inherit the value.
*
* They are used by the macros defined below.
@@ -2600,20 +2600,20 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
/*
* A ProcessGlobalValue struct exists for each internal value in Tcl that is
* to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
- * the value, and the master is kept as a counted string, with epoch and mutex
- * control. Each ProcessGlobalValue struct should be a static variable in some
- * file.
+ * the value, and the gobal value is kept as a counted string, with epoch and
+ * mutex control. Each ProcessGlobalValue struct should be a static variable in
+ * some file.
*/
typedef struct ProcessGlobalValue {
int epoch; /* Epoch counter to detect changes in the
- * master value. */
- int numBytes; /* Length of the master string. */
- char *value; /* The master string value. */
- Tcl_Encoding encoding; /* system encoding when master string was
+ * global value. */
+ int numBytes; /* Length of the global string. */
+ char *value; /* The global string value. */
+ Tcl_Encoding encoding; /* system encoding when global string was
* initialized. */
TclInitProcessGlobalValueProc *proc;
- /* A procedure to initialize the master string
+ /* A procedure to initialize the global string
* copy when a "get" request comes in before
* any "set" request has been received. */
Tcl_Mutex mutex; /* Enforce orderly access from multiple
@@ -3097,8 +3097,8 @@ MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
-MODULE_SCOPE void TclpMasterLock(void);
-MODULE_SCOPE void TclpMasterUnlock(void);
+MODULE_SCOPE void TclpGlobalLock(void);
+MODULE_SCOPE void TclpGlobalUnlock(void);
MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators,
Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp,
@@ -3242,8 +3242,8 @@ MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
-MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
-MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
+MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 198fa6a..8915792 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -141,7 +141,7 @@ TclThreadDataKeyGet(
* Keep a list of (mutexes/condition variable/data key) used during
* finalization.
*
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -202,7 +202,7 @@ RememberSyncObject(
* ForgetSyncObject
*
* Remove a single object from the list.
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -234,7 +234,7 @@ ForgetSyncObject(
* TclRememberMutex
*
* Keep a list of mutexes used during finalization.
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -276,9 +276,9 @@ Tcl_MutexFinalize(
#ifdef TCL_THREADS
TclpFinalizeMutex(mutexPtr);
#endif
- TclpMasterLock();
+ TclpGlobalLock();
ForgetSyncObject(mutexPtr, &mutexRecord);
- TclpMasterUnlock();
+ TclpGlobalUnlock();
}
/*
@@ -287,7 +287,7 @@ Tcl_MutexFinalize(
* TclRememberCondition
*
* Keep a list of condition variables used during finalization.
- * Assume master lock is held.
+ * Assume global lock is held.
*
* Results:
* None.
@@ -329,9 +329,9 @@ Tcl_ConditionFinalize(
#ifdef TCL_THREADS
TclpFinalizeCondition(condPtr);
#endif
- TclpMasterLock();
+ TclpGlobalLock();
ForgetSyncObject(condPtr, &condRecord);
- TclpMasterUnlock();
+ TclpGlobalUnlock();
}
/*
@@ -393,7 +393,7 @@ TclFinalizeSynchronization(void)
Tcl_Mutex *mutexPtr;
Tcl_Condition *condPtr;
- TclpMasterLock();
+ TclpGlobalLock();
#endif
/*
@@ -415,7 +415,7 @@ TclFinalizeSynchronization(void)
#ifdef TCL_THREADS
/*
- * Call thread storage master cleanup.
+ * Call thread storage global cleanup.
*/
TclFinalizeThreadStorage();
@@ -446,7 +446,7 @@ TclFinalizeSynchronization(void)
condRecord.max = 0;
condRecord.num = 0;
- TclpMasterUnlock();
+ TclpGlobalUnlock();
#endif /* TCL_THREADS */
}
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 755a461..ad8c50f 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -27,11 +27,11 @@
*/
/*
- * The master collection of information about TSDs. This is shared across the
+ * The global collection of information about TSDs. This is shared across the
* whole process, and includes the mutex used to protect it.
*/
-static struct TSDMaster {
+static struct {
void *key; /* Key into the system TSD structure. The
* collection of Tcl TSD values for a
* particular thread will hang off the
@@ -41,13 +41,13 @@ static struct TSDMaster {
* increasing value. */
Tcl_Mutex mutex; /* Protection for the rest of this structure,
* which holds per-process data. */
-} tsdMaster = { NULL, 0, NULL };
+} tsdGlobal = { NULL, 0, NULL };
/*
* The type of the data held per thread in a system TSD.
*/
-typedef struct TSDTable {
+typedef struct {
ClientData *tablePtr; /* The table of Tcl TSDs. */
sig_atomic_t allocated; /* The size of the table in the current
* thread. */
@@ -57,7 +57,7 @@ typedef struct TSDTable {
* The actual type of Tcl_ThreadDataKey.
*/
-typedef union TSDUnion {
+typedef union {
volatile sig_atomic_t offset;
/* The type is really an offset into the
* thread-local table of TSDs, which is this
@@ -189,7 +189,7 @@ void *
TclThreadStorageKeyGet(
Tcl_ThreadDataKey *dataKeyPtr)
{
- TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
ClientData resultPtr = NULL;
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
sig_atomic_t offset = keyPtr->offset;
@@ -223,12 +223,12 @@ TclThreadStorageKeySet(
Tcl_ThreadDataKey *dataKeyPtr,
void *value)
{
- TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
if (tsdTablePtr == NULL) {
tsdTablePtr = TSDTableCreate();
- TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
+ TclpThreadSetGlobalTSD(tsdGlobal.key, tsdTablePtr);
}
/*
@@ -240,15 +240,15 @@ TclThreadStorageKeySet(
*/
if (keyPtr->offset == 0) {
- Tcl_MutexLock(&tsdMaster.mutex);
+ Tcl_MutexLock(&tsdGlobal.mutex);
if (keyPtr->offset == 0) {
/*
* The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
*/
- keyPtr->offset = ++tsdMaster.counter;
+ keyPtr->offset = ++tsdGlobal.counter;
}
- Tcl_MutexUnlock(&tsdMaster.mutex);
+ Tcl_MutexUnlock(&tsdGlobal.mutex);
}
/*
@@ -288,11 +288,11 @@ TclThreadStorageKeySet(
void
TclFinalizeThreadDataThread(void)
{
- TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
+ TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
if (tsdTablePtr != NULL) {
TSDTableDelete(tsdTablePtr);
- TclpThreadSetMasterTSD(tsdMaster.key, NULL);
+ TclpThreadSetGlobalTSD(tsdGlobal.key, NULL);
}
}
@@ -316,7 +316,7 @@ TclFinalizeThreadDataThread(void)
void
TclInitThreadStorage(void)
{
- tsdMaster.key = TclpThreadCreateKey();
+ tsdGlobal.key = TclpThreadCreateKey();
}
/*
@@ -339,8 +339,8 @@ TclInitThreadStorage(void)
void
TclFinalizeThreadStorage(void)
{
- TclpThreadDeleteKey(tsdMaster.key);
- tsdMaster.key = NULL;
+ TclpThreadDeleteKey(tsdGlobal.key);
+ tsdGlobal.key = NULL;
}
#else /* !TCL_THREADS */
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index a9819d5..9efdbc3 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -4263,8 +4263,8 @@ TclGetProcessGlobalValue(
if (pgvPtr->encoding != current) {
/*
- * The system encoding has changed since the master string value
- * was saved. Convert the master value to be based on the new
+ * The system encoding has changed since the global string value
+ * was saved. Convert the global value to be based on the new
* system encoding.
*/
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index ef8e737..68852a1 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -22,23 +22,23 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
/*
- * masterLock is used to serialize creation of mutexes, condition variables,
+ * globalLock is used to serialize creation of mutexes, condition variables,
* and thread local storage. This is the only place that can count on the
* ability to statically initialize the mutex.
*/
-static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;
+static pthread_mutex_t globalLock = PTHREAD_MUTEX_INITIALIZER;
/*
* initLock is used to serialize initialization and finalization of Tcl. It
- * cannot use any dyamically allocated storage.
+ * cannot use any dynamically allocated storage.
*/
static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;
/*
* allocLock is used by Tcl's version of malloc for synchronization. For
- * obvious reasons, cannot use any dyamically allocated storage.
+ * obvious reasons, cannot use any dynamically allocated storage.
*/
static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
@@ -48,8 +48,8 @@ static pthread_mutex_t *allocLockPtr = &allocLock;
* These are for the critical sections inside this file.
*/
-#define MASTER_LOCK pthread_mutex_lock(&masterLock)
-#define MASTER_UNLOCK pthread_mutex_unlock(&masterLock)
+#define GLOBAL_LOCK pthread_mutex_lock(&globalLock)
+#define GLOBAL_UNLOCK pthread_mutex_unlock(&globalLock)
#endif /* TCL_THREADS */
@@ -274,7 +274,7 @@ TclFinalizeLock(void)
/*
* You do not need to destroy mutexes that were created with the
* PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
- * destruction: masterLock, allocLock, and initLock.
+ * destruction: globalLock, allocLock, and initLock.
*/
pthread_mutex_unlock(&initLock);
@@ -309,7 +309,7 @@ TclpInitUnlock(void)
/*
*----------------------------------------------------------------------
*
- * TclpMasterLock
+ * TclpGlobalLock
*
* This procedure is used to grab a lock that serializes creation and
* finalization of serialization objects. This interface is only needed
@@ -322,16 +322,16 @@ TclpInitUnlock(void)
* None.
*
* Side effects:
- * Acquire the master mutex.
+ * Acquire the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterLock(void)
+TclpGlobalLock(void)
{
#ifdef TCL_THREADS
- pthread_mutex_lock(&masterLock);
+ pthread_mutex_lock(&globalLock);
#endif
}
@@ -339,7 +339,7 @@ TclpMasterLock(void)
/*
*----------------------------------------------------------------------
*
- * TclpMasterUnlock
+ * TclpGlobalUnlock
*
* This procedure is used to release a lock that serializes creation and
* finalization of synchronization objects.
@@ -348,16 +348,16 @@ TclpMasterLock(void)
* None.
*
* Side effects:
- * Release the master mutex.
+ * Release the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterUnlock(void)
+TclpGlobalUnlock(void)
{
#ifdef TCL_THREADS
- pthread_mutex_unlock(&masterLock);
+ pthread_mutex_unlock(&globalLock);
#endif
}
@@ -367,7 +367,7 @@ TclpMasterUnlock(void)
* Tcl_GetAllocMutex
*
* This procedure returns a pointer to a statically initialized mutex for
- * use by the memory allocator. The alloctor must use this lock, because
+ * use by the memory allocator. The allocator must use this lock, because
* all other locks are allocated...
*
* Results:
@@ -421,10 +421,10 @@ Tcl_MutexLock(
pthread_mutex_t *pmutexPtr;
if (*mutexPtr == NULL) {
- MASTER_LOCK;
+ GLOBAL_LOCK;
if (*mutexPtr == NULL) {
/*
- * Double inside master lock check to avoid a race condition.
+ * Double inside global lock check to avoid a race condition.
*/
pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
@@ -432,7 +432,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex)pmutexPtr;
TclRememberMutex(mutexPtr);
}
- MASTER_UNLOCK;
+ GLOBAL_UNLOCK;
}
pmutexPtr = *((pthread_mutex_t **)mutexPtr);
pthread_mutex_lock(pmutexPtr);
@@ -472,7 +472,7 @@ Tcl_MutexUnlock(
* This procedure is invoked to clean up one mutex. This is only safe to
* call at the end of time.
*
- * This assumes the Master Lock is held.
+ * This assumes the Global Lock is held.
*
* Results:
* None.
@@ -529,7 +529,7 @@ Tcl_ConditionWait(
struct timespec ptime;
if (*condPtr == NULL) {
- MASTER_LOCK;
+ GLOBAL_LOCK;
/*
* Double check inside mutex to avoid race, then initialize condition
@@ -542,7 +542,7 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
}
- MASTER_UNLOCK;
+ GLOBAL_UNLOCK;
}
pmutexPtr = *((pthread_mutex_t **)mutexPtr);
pcondPtr = *((pthread_cond_t **)condPtr);
@@ -605,7 +605,7 @@ Tcl_ConditionNotify(
* This procedure is invoked to clean up a condition variable. This is
* only safe to call at the end of time.
*
- * This assumes the Master Lock is held.
+ * This assumes the Global Lock is held.
*
* Results:
* None.
@@ -793,19 +793,19 @@ TclpThreadDeleteKey(
}
void
-TclpThreadSetMasterTSD(
+TclpThreadSetGlobalTSD(
void *tsdKeyPtr,
void *ptr)
{
pthread_key_t *ptkeyPtr = tsdKeyPtr;
if (pthread_setspecific(*ptkeyPtr, ptr)) {
- Tcl_Panic("unable to set master TSD value");
+ Tcl_Panic("unable to set global TSD value");
}
}
void *
-TclpThreadGetMasterTSD(
+TclpThreadGetGlobalTSD(
void *tsdKeyPtr)
{
pthread_key_t *ptkeyPtr = tsdKeyPtr;
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 5316075..44b5f6c 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -24,18 +24,18 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask
#endif
/*
- * This is the master lock used to serialize access to other serialization
+ * This is the global lock used to serialize access to other serialization
* data structures.
*/
-static CRITICAL_SECTION masterLock;
+static CRITICAL_SECTION globalLock;
static int init = 0;
-#define MASTER_LOCK TclpMasterLock()
-#define MASTER_UNLOCK TclpMasterUnlock()
+#define GLOBAL_LOCK TclpGlobalLock()
+#define GLOBAL_UNLOCK TclpGlobalUnlock()
/*
- * This is the master lock used to serialize initialization and finalization
+ * This is the global lock used to serialize initialization and finalization
* of Tcl as a whole.
*/
@@ -43,7 +43,7 @@ static CRITICAL_SECTION initLock;
/*
* allocLock is used by Tcl's version of malloc for synchronization. For
- * obvious reasons, cannot use any dyamically allocated storage.
+ * obvious reasons, cannot use any dynamically allocated storage.
*/
#ifdef TCL_THREADS
@@ -368,7 +368,7 @@ TclpInitLock(void)
init = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
- InitializeCriticalSection(&masterLock);
+ InitializeCriticalSection(&globalLock);
}
EnterCriticalSection(&initLock);
}
@@ -399,7 +399,7 @@ TclpInitUnlock(void)
/*
*----------------------------------------------------------------------
*
- * TclpMasterLock
+ * TclpGlobalLock
*
* This procedure is used to grab a lock that serializes creation of
* mutexes, condition variables, and thread local storage keys.
@@ -411,13 +411,13 @@ TclpInitUnlock(void)
* None.
*
* Side effects:
- * Acquire the master mutex.
+ * Acquire the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterLock(void)
+TclpGlobalLock(void)
{
if (!init) {
/*
@@ -430,15 +430,15 @@ TclpMasterLock(void)
init = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
- InitializeCriticalSection(&masterLock);
+ InitializeCriticalSection(&globalLock);
}
- EnterCriticalSection(&masterLock);
+ EnterCriticalSection(&globalLock);
}
/*
*----------------------------------------------------------------------
*
- * TclpMasterUnlock
+ * TclpGlobalUnlock
*
* This procedure is used to release a lock that serializes creation and
* deletion of synchronization objects.
@@ -447,15 +447,15 @@ TclpMasterLock(void)
* None.
*
* Side effects:
- * Release the master mutex.
+ * Release the global mutex.
*
*----------------------------------------------------------------------
*/
void
-TclpMasterUnlock(void)
+TclpGlobalUnlock(void)
{
- LeaveCriticalSection(&masterLock);
+ LeaveCriticalSection(&globalLock);
}
/*
@@ -464,7 +464,7 @@ TclpMasterUnlock(void)
* Tcl_GetAllocMutex
*
* This procedure returns a pointer to a statically initialized mutex for
- * use by the memory allocator. The alloctor must use this lock, because
+ * use by the memory allocator. The allocator must use this lock, because
* all other locks are allocated...
*
* Results:
@@ -512,14 +512,14 @@ Tcl_GetAllocMutex(void)
void
TclFinalizeLock(void)
{
- MASTER_LOCK;
+ GLOBAL_LOCK;
DeleteCriticalSection(&joinLock);
/*
* Destroy the critical section that we are holding!
*/
- DeleteCriticalSection(&masterLock);
+ DeleteCriticalSection(&globalLock);
init = 0;
#ifdef TCL_THREADS
@@ -567,10 +567,10 @@ Tcl_MutexLock(
CRITICAL_SECTION *csPtr;
if (*mutexPtr == NULL) {
- MASTER_LOCK;
+ GLOBAL_LOCK;
/*
- * Double inside master lock check to avoid a race.
+ * Double inside global lock check to avoid a race.
*/
if (*mutexPtr == NULL) {
@@ -579,7 +579,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
}
- MASTER_UNLOCK;
+ GLOBAL_UNLOCK;
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
EnterCriticalSection(csPtr);
@@ -681,7 +681,7 @@ Tcl_ConditionWait(
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
- MASTER_LOCK;
+ GLOBAL_LOCK;
/*
* Create the per-thread event and queue pointers.
@@ -695,14 +695,14 @@ Tcl_ConditionWait(
tsdPtr->flags = WIN_THREAD_RUNNING;
doExit = 1;
}
- MASTER_UNLOCK;
+ GLOBAL_UNLOCK;
if (doExit) {
/*
* Create a per-thread exit handler to clean up the condEvent. We
- * must be careful to do this outside the Master Lock because
+ * must be careful to do this outside the Global Lock because
* Tcl_CreateThreadExitHandler uses its own ThreadSpecificData,
- * and initializing that may drop back into the Master Lock.
+ * and initializing that may drop back into the Global Lock.
*/
Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
@@ -710,7 +710,7 @@ Tcl_ConditionWait(
}
if (*condPtr == NULL) {
- MASTER_LOCK;
+ GLOBAL_LOCK;
/*
* Initialize the per-condition queue pointers and Mutex.
@@ -724,7 +724,7 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) winCondPtr;
TclRememberCondition(condPtr);
}
- MASTER_UNLOCK;
+ GLOBAL_UNLOCK;
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
winCondPtr = *((WinCondition **)condPtr);
@@ -902,7 +902,7 @@ FinalizeConditionEvent(
* This procedure is invoked to clean up a condition variable. This is
* only safe to call at the end of time.
*
- * This assumes the Master Lock is held.
+ * This assumes the Global Lock is held.
*
* Results:
* None.
@@ -1073,19 +1073,19 @@ TclpThreadDeleteKey(
}
void
-TclpThreadSetMasterTSD(
+TclpThreadSetGlobalTSD(
void *tsdKeyPtr,
void *ptr)
{
DWORD *key = tsdKeyPtr;
if (!TlsSetValue(*key, ptr)) {
- Tcl_Panic("unable to set master TSD value");
+ Tcl_Panic("unable to set global TSD value");
}
}
void *
-TclpThreadGetMasterTSD(
+TclpThreadGetGlobalTSD(
void *tsdKeyPtr)
{
DWORD *key = tsdKeyPtr;
--
cgit v0.12
From f472165a3dc7d353f90af7f8143d2780b11c93fe Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 21 Jul 2020 12:26:05 +0000
Subject: Mark chan-io-50.? and event-1.1 as nonPortable (for now): Those
sometimes fail in the Travis environment, but in practice this doesn't seem
to be a real problem.
---
tests/chanio.test | 12 ++++++------
tests/event.test | 2 +-
2 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index 558ec10..67e0f24 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6372,7 +6372,7 @@ test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
test chan-io-50.1 {testing handler deletion} -setup {
file delete $path(test1)
-} -constraints {testchannelevent} -body {
+} -constraints {testchannelevent nonPortable} -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1) r]
@@ -6390,7 +6390,7 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints {testchannelevent} -body {
+} -constraints {testchannelevent nonPortable} -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list delhandler $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
@@ -6409,7 +6409,7 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints {testchannelevent} -body {
+} -constraints {testchannelevent nonPortable} -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list notcalled $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
@@ -6435,7 +6435,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
+} -constraints {testchannelevent nonPortable} -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
if {$u eq "recursive"} {
@@ -6458,7 +6458,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
+} -constraints {testchannelevent nonPortable} -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list notcalled $f]]
testchannelevent $f add readable [namespace code [list del $f]]
@@ -6493,7 +6493,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
+} -constraints {testchannelevent nonPortable} -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list second $f]]
testchannelevent $f add readable [namespace code [list first $f]]
diff --git a/tests/event.test b/tests/event.test
index 67a980b..6e6d116 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -27,7 +27,7 @@ testConstraint exec [llength [info commands exec]]
test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler close
set result ""
-} -constraints {testfilehandler} -body {
+} -constraints {testfilehandler nonPortable} -body {
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
--
cgit v0.12
From 55bf49d15f4347284e30f07c67f8043b0669704f Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 21 Jul 2020 13:22:08 +0000
Subject: Re-enable event-1.1, io-50.? and chan-io-50.? test-cases, trying to
get a hand at the problem [f586089a2b]
---
tests/chanio.test | 20 ++++++------
tests/event.test | 8 ++---
tests/io.test | 92 +++++++++++++++++++++++++++----------------------------
3 files changed, 60 insertions(+), 60 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index 67e0f24..5989bfe 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6372,7 +6372,7 @@ test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
test chan-io-50.1 {testing handler deletion} -setup {
file delete $path(test1)
-} -constraints {testchannelevent nonPortable} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1) r]
@@ -6382,7 +6382,7 @@ test chan-io-50.1 {testing handler deletion} -setup {
}]
variable z not_called
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result called
@@ -6390,7 +6390,7 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints {testchannelevent nonPortable} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list delhandler $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
@@ -6409,7 +6409,7 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints {testchannelevent nonPortable} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list notcalled $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
@@ -6435,7 +6435,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent nonPortable} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
if {$u eq "recursive"} {
@@ -6450,7 +6450,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
variable u toplevel
variable z ""
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
@@ -6458,7 +6458,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent nonPortable} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list notcalled $f]]
testchannelevent $f add readable [namespace code [list del $f]]
@@ -6484,7 +6484,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
set z ""
set u toplevel
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result [list {del calling recursive} {del deleted notcalled} \
@@ -6493,7 +6493,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent nonPortable} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list second $f]]
testchannelevent $f add readable [namespace code [list first $f]]
@@ -6527,7 +6527,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
set z ""
set u toplevel
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result [list {first called} {first called not toplevel} \
diff --git a/tests/event.test b/tests/event.test
index 6e6d116..336c4e4 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -27,7 +27,7 @@ testConstraint exec [llength [info commands exec]]
test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler close
set result ""
-} -constraints {testfilehandler nonPortable} -body {
+} -constraints testfilehandler -body {
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
@@ -595,16 +595,16 @@ test event-11.7 {Bug 16828b3744} {
test event-11.8 {Bug 16828b3744} -setup {
oo::class create A {
variable continue
-
+
method start {} {
after idle [self] destroy
-
+
set continue 0
vwait [namespace current]::continue
}
destructor {
set continue 1
- }
+ }
}
} -body {
[A new] start
diff --git a/tests/io.test b/tests/io.test
index 7072b63..1a30850 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -123,10 +123,10 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
# applied to tcl will cause tcl, more specifically WriteChars, to
# go into an infinite loop.
- set f [open $path(test2) w]
- fconfigure $f -encoding iso2022-jp
- puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
- close $f
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp
+ puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
+ close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
@@ -192,7 +192,7 @@ test io-1.9 {Tcl_WriteChars: WriteChars} {
test io-2.1 {WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -214,7 +214,7 @@ test io-2.3 {WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -234,7 +234,7 @@ test io-2.4 {WriteBytes: reset sawLF after each buffer} {
test io-3.1 {WriteChars: compatibility with WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -256,7 +256,7 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -268,7 +268,7 @@ test io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 16
+ fconfigure $f -encoding jis0208 -buffersize 16
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -280,7 +280,7 @@ test io-3.5 {WriteChars: saved != 0} {
# requested buffersize.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -311,7 +311,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# of the next channel buffer.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -381,7 +381,7 @@ test io-4.5 {TranslateOutputEOL: crlf} {
test io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
- fconfigure $f
+ fconfigure $f
puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
close $f
@@ -470,7 +470,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
- # if (dst >= dstEnd)
+ # if (dst >= dstEnd)
set f [open $path(test1) w]
puts $f $a
@@ -769,7 +769,7 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel}
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
# eol still equals dstEnd
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -781,8 +781,8 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\rabcd\r\nefg"
@@ -889,7 +889,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "\nabcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -898,7 +898,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
@@ -906,7 +906,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "abcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -959,10 +959,10 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testcha
set x [list [gets $f] [testchannel inputbuffered $f]]
close $f
set x
-} [list "123456789012345" 15]
+} [list "123456789012345" 15]
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
# PeekAhead() did not get any, so (eol >= dstEnd)
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -975,7 +975,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testc
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
# if (*eol == '\n') {skip++}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r\n78901"
@@ -986,8 +986,8 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r78901"
@@ -999,7 +999,7 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
# else if (*eol == '\n') {goto gotoeol;}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\n78901"
@@ -1092,7 +1092,7 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
@@ -1201,7 +1201,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x [gets $f]
close $f
- set x
+ set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
@@ -1217,7 +1217,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
- # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
@@ -1574,7 +1574,7 @@ test io-13.2 {TranslateInputEOL: crlf mode} {
set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1587,7 +1587,7 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1600,7 +1600,7 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1715,7 +1715,7 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
- # not (*src == '\r')
+ # not (*src == '\r')
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -2064,7 +2064,7 @@ test io-20.1 {Tcl_CreateChannel: initial settings} {
encoding system $old
close $a
set x
-} {ascii}
+} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
@@ -2159,7 +2159,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
-} {}
+} {}
# Test flushing. The functions tested here are FlushChannel.
@@ -3057,7 +3057,7 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
fconfigure $f -translation crlf
set x [read $f]
close $f
- set x
+ set x
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
file delete $path(test1)
@@ -3985,7 +3985,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
}
close $f
set f [open $path(test1) r]
- fconfigure $f -translation crlf
+ fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
append c $line\n
@@ -5474,7 +5474,7 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -encoding {}
+ fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
close $f
set f [open $path(test1) r]
@@ -6719,7 +6719,7 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
+test io-50.1 {testing handler deletion} testchannelevent {
file delete $path(test1)
set f [open $path(test1) w]
close $f
@@ -6735,7 +6735,7 @@ test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
close $f
set z
} called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
+test io-50.2 {testing handler deletion with multiple handlers} testchannelevent {
file delete $path(test1)
set f [open $path(test1) w]
close $f
@@ -6753,7 +6753,7 @@ test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent
string compare [string tolower $z] \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
} 0
-test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
+test io-50.3 {testing handler deletion with multiple handlers} testchannelevent {
file delete $path(test1)
set f [open $path(test1) w]
close $f
@@ -6779,7 +6779,7 @@ test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+test io-50.4 {testing handler deletion vs reentrant calls} testchannelevent {
file delete $path(test1)
set f [open $path(test1) w]
close $f
@@ -6803,7 +6803,7 @@ test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent non
close $f
set z
} {{delrecursive calling recursive} {delrecursive deleting recursive}}
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+test io-50.5 {testing handler deletion vs reentrant calls} testchannelevent {
file delete $path(test1)
set f [open $path(test1) w]
close $f
@@ -6833,10 +6833,10 @@ test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent non
set u toplevel
update
close $f
- set z
+ set z
} [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+test io-50.6 {testing handler deletion vs reentrant calls} testchannelevent {
file delete $path(test1)
set f [open $path(test1) w]
close $f
@@ -8648,11 +8648,11 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
interp create slave
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
- read [teststringobj get 1]
+ read [teststringobj get 1]
testobj duplicate 1 2
interp transfer {} $rfd slave
catch {read [teststringobj get 1]}
- read [teststringobj get 2]
+ read [teststringobj get 2]
} -cleanup {
interp delete slave
testobj freeallvars
--
cgit v0.12
From 7fba80338f20600d84ce7685436e377329c4c970 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 22 Jul 2020 15:28:39 +0000
Subject: Convert test-cases to do proper setup/cleanup
---
tests/io.test | 46 +++++++++++++++++++++++++++++-----------------
1 file changed, 29 insertions(+), 17 deletions(-)
diff --git a/tests/io.test b/tests/io.test
index 1a30850..86e426c 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6719,8 +6719,9 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} testchannelevent {
+test io-50.1 {testing handler deletion} -constraints testchannelevent -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6732,11 +6733,13 @@ test io-50.1 {testing handler deletion} testchannelevent {
}
set z not_called
update
- close $f
set z
-} called
-test io-50.2 {testing handler deletion with multiple handlers} testchannelevent {
+} -cleanup {
+ close $f
+} -result called
+test io-50.2 {testing handler deletion with multiple handlers} -constraints testchannelevent -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6749,12 +6752,14 @@ test io-50.2 {testing handler deletion with multiple handlers} testchannelevent
}
set z ""
update
- close $f
string compare [string tolower $z] \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
-} 0
-test io-50.3 {testing handler deletion with multiple handlers} testchannelevent {
+} -cleanup {
+ close $f
+} -result 0
+test io-50.3 {testing handler deletion with multiple handlers} -constraints testchannelevent -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6774,13 +6779,15 @@ test io-50.3 {testing handler deletion with multiple handlers} testchannelevent
}
set z ""
update
- close $f
string compare [string tolower $z] \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
-} 0
-test io-50.4 {testing handler deletion vs reentrant calls} testchannelevent {
+} -cleanup {
+ close $f
+} -result 0
+test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6800,11 +6807,13 @@ test io-50.4 {testing handler deletion vs reentrant calls} testchannelevent {
variable u toplevel
variable z ""
update
- close $f
set z
-} {{delrecursive calling recursive} {delrecursive deleting recursive}}
-test io-50.5 {testing handler deletion vs reentrant calls} testchannelevent {
+} -cleanup {
+ close $f
+} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6834,10 +6843,12 @@ test io-50.5 {testing handler deletion vs reentrant calls} testchannelevent {
update
close $f
set z
-} [list {del calling recursive} {del deleted notcalled} \
+} -cleanup {
+} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
-test io-50.6 {testing handler deletion vs reentrant calls} testchannelevent {
+test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6873,9 +6884,10 @@ test io-50.6 {testing handler deletion vs reentrant calls} testchannelevent {
set z ""
set u toplevel
update
- close $f
set z
-} [list {first called} {first called not toplevel} \
+} -cleanup {
+ close $f
+} -result [list {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
{first after update}]
--
cgit v0.12
From 0d231a3919435409be9374f0a792e364e804b20c Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Thu, 23 Jul 2020 13:32:03 +0000
Subject: Check if reverting from os_unfair_lock to OSSpinLock has any effect.
---
macosx/tclMacOSXNotify.c | 2 ++
1 file changed, 2 insertions(+)
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index bbbac65..7f451c7 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -20,11 +20,13 @@
* OSSpinLock, and the OSSpinLock was deprecated.
*/
+#if 0
#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200
#define USE_OS_UNFAIR_LOCK
#include <os/lock.h>
#undef TCL_MAC_DEBUG_NOTIFIER
#endif
+#endif
#ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is
* in tclUnixNotfy.c */
--
cgit v0.12
--
cgit v0.12
From 7c4cabaaae8d1f5b351e2016d56308e2531cca9b Mon Sep 17 00:00:00 2001
From: kjnash <k.j.nash@usa.net>
Date: Fri, 24 Jul 2020 20:32:20 +0000
Subject: Fix for bug cb0373bb33. In HTTP/1.1 the response header
"Connection", if absent, must default to "keep-alive". Add test http11-1.13
and bump version to 2.9.3.
---
library/http/http.tcl | 33 ++++++++++++++++++++++++++++-----
library/http/pkgIndex.tcl | 2 +-
tests/http11.test | 37 +++++++++++++++++++++++++++++++++++++
tests/httpPipeline.test | 2 +-
unix/Makefile.in | 4 ++--
win/Makefile.in | 4 ++--
6 files changed, 71 insertions(+), 11 deletions(-)
diff --git a/library/http/http.tcl b/library/http/http.tcl
index a93e67b..6e2ac4e 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.9.2
+package provide http 2.9.3
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -721,7 +721,7 @@ proc http::geturl {url args} {
body {}
status ""
http ""
- connection close
+ connection keep-alive
}
set state(-keepalive) $defaultKeepalive
set state(-strict) $strict
@@ -1037,7 +1037,7 @@ proc http::geturl {url args} {
}
# Do not automatically close the connection socket.
- set state(connection) {}
+ set state(connection) keep-alive
}
}
@@ -2688,8 +2688,31 @@ proc http::Event {sock token} {
}
proxy-connection -
connection {
- set state(connection) \
- [string trim [string tolower $value]]
+ set tmpHeader [string trim [string tolower $value]]
+ # RFC 7230 Section 6.1 states that a comma-separated
+ # list is an acceptable value. According to
+ # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
+ # any comma-separated list implies keep-alive, but I
+ # don't see this in the RFC so we'll play safe and
+ # scan any list for "close".
+ if {$tmpHeader in {close keep-alive}} {
+ # The common cases, continue.
+ } elseif {[string first , $tmpHeader] == -1} {
+ # Not a comma-separated list, not "close",
+ # therefore "keep-alive".
+ set tmpHeader keep-alive
+ } else {
+ set tmpHeader keep-alive
+ set tmpCsl [split $tmpHeader ,]
+ # Optional whitespace either side of separator.
+ foreach el $tmpCsl {
+ if {[string trim $el] eq {close}} {
+ set tmpHeader close
+ break
+ }
+ }
+ }
+ set state(connection) $tmpHeader
}
}
lappend state(meta) $key [string trim $value]
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 4f5eafb..43cd86b 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
-package ifneeded http 2.9.2 [list tclPkgSetup $dir http 2.9.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.9.3 [list tclPkgSetup $dir http 2.9.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/tests/http11.test b/tests/http11.test
index 1e30802..6d93d36 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -60,6 +60,20 @@ proc meta {tok {key ""}} {
return $meta
}
+proc state {tok {key ""}} {
+ upvar 1 $tok state
+ if {$key ne ""} {
+ if {[array names state -exact $key] ne {}} {
+ return $state($key)
+ } else {
+ return ""
+ }
+ }
+ set res [array get state]
+ dict set res body <elided>
+ return $res
+}
+
proc check_crc {tok args} {
set crc [meta $tok x-crc32]
set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
@@ -241,6 +255,29 @@ test http11-1.12 "normal,identity,chunked" -setup {
halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
+test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup {
+ variable httpd [create_httpd]
+ set zipTmp [http::config -zip]
+ http::config -zip 0
+} -body {
+ set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
+ -protocol 1.1 -keepalive 1 -timeout 10000]
+ http::wait $tok
+ set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \
+ [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]]
+ set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
+ -protocol 1.1 -keepalive 1 -timeout 10000]
+ http::wait $toj
+ set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \
+ [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]]
+ concat $res1 -- $res2
+} -cleanup {
+ http::cleanup $tok
+ http::cleanup $toj
+ halt_httpd
+ http::config -zip $zipTmp
+} -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive}
+
# -------------------------------------------------------------------------
test http11-2.0 "-channel" -setup {
diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
index 8de79b9..de1a7d8 100644
--- a/tests/httpPipeline.test
+++ b/tests/httpPipeline.test
@@ -11,7 +11,7 @@
package require tcltest 2
namespace import -force ::tcltest::*
-package require http 2.8
+package require http 2.9
set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 5a023e2..3e0dd1e 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -944,8 +944,8 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing package http 2.9.2 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.2.tm";
+ @echo "Installing package http 2.9.3 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm";
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
diff --git a/win/Makefile.in b/win/Makefile.in
index 651f6b2..7c0db47 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -719,8 +719,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing package http 2.9.2 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.2.tm";
+ @echo "Installing package http 2.9.3 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm";
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
--
cgit v0.12
From e14cd07627b4ca6018dc89e9333418965ef0d56b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 25 Jul 2020 15:56:10 +0000
Subject: Fix [20dccf1200]: htons-related test fails on Mac OSX Catalina
(10.15) Also, let http-related tests check if really http 2.9 is present
---
tests/http11.test | 2 +-
tests/httpPipeline.test | 2 +-
tests/socket.test | 4 ++--
3 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/tests/http11.test b/tests/http11.test
index 1e30802..7f59f79 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -10,7 +10,7 @@
package require tcltest 2
namespace import -force ::tcltest::*
-package require http 2.8
+package require http 2.9
# start the server
variable httpd_output
diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
index 8de79b9..de1a7d8 100644
--- a/tests/httpPipeline.test
+++ b/tests/httpPipeline.test
@@ -11,7 +11,7 @@
package require tcltest 2
namespace import -force ::tcltest::*
-package require http 2.8
+package require http 2.9
set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
diff --git a/tests/socket.test b/tests/socket.test
index 55b4f2f..87169ae 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -904,7 +904,7 @@ test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}
test socket_$af-5.2 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 0x10000} msg]} {
close $msg
@@ -918,7 +918,7 @@ test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}
test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup {
proc myHandler {msg options} {
--
cgit v0.12
From ca51d20173c55f80a6d14a618d3d95880fb0e4f7 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 3 Aug 2020 15:23:42 +0000
Subject: Testcase cleanup: transform *io-50.* testcases to new test syntax
---
tests/chanio.test | 17 ++++---
tests/io.test | 135 ++++++++++++++++++++++++++++++------------------------
2 files changed, 85 insertions(+), 67 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index 67e0f24..07a0d8d 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5642,7 +5642,9 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
catch {chan close $f2}
catch {chan close $f3}
} -result {bad-write {}}
-test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test chan-io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs openpipe fileevent
+} -body {
set f4 [openpipe r $path(cat) << foo]
chan event $f4 readable [namespace code {
if {[chan gets $f4 line] < 0} {
@@ -5655,9 +5657,10 @@ test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- chan close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ chan close $f4
+} -result {initial foo eof}
chan close $f
makeFile "foo bar" foo
@@ -6382,7 +6385,7 @@ test chan-io-50.1 {testing handler deletion} -setup {
}]
variable z not_called
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result called
@@ -6450,7 +6453,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
variable u toplevel
variable z ""
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
@@ -6484,7 +6487,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
set z ""
set u toplevel
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result [list {del calling recursive} {del deleted notcalled} \
@@ -6527,7 +6530,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
set z ""
set u toplevel
update
- return $z
+ set z
} -cleanup {
chan close $f
} -result [list {first called} {first called not toplevel} \
diff --git a/tests/io.test b/tests/io.test
index 7072b63..e2b1a89 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -123,10 +123,10 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
# applied to tcl will cause tcl, more specifically WriteChars, to
# go into an infinite loop.
- set f [open $path(test2) w]
- fconfigure $f -encoding iso2022-jp
- puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
- close $f
+ set f [open $path(test2) w]
+ fconfigure $f -encoding iso2022-jp
+ puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
+ close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
@@ -192,7 +192,7 @@ test io-1.9 {Tcl_WriteChars: WriteChars} {
test io-2.1 {WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -214,7 +214,7 @@ test io-2.3 {WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -234,7 +234,7 @@ test io-2.4 {WriteBytes: reset sawLF after each buffer} {
test io-3.1 {WriteChars: compatibility with WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -256,7 +256,7 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -268,7 +268,7 @@ test io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 16
+ fconfigure $f -encoding jis0208 -buffersize 16
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -280,7 +280,7 @@ test io-3.5 {WriteChars: saved != 0} {
# requested buffersize.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -311,7 +311,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# of the next channel buffer.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -381,7 +381,7 @@ test io-4.5 {TranslateOutputEOL: crlf} {
test io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
- fconfigure $f
+ fconfigure $f
puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
close $f
@@ -470,7 +470,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
- # if (dst >= dstEnd)
+ # if (dst >= dstEnd)
set f [open $path(test1) w]
puts $f $a
@@ -769,7 +769,7 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel}
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
# eol still equals dstEnd
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -781,8 +781,8 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\rabcd\r\nefg"
@@ -889,7 +889,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "\nabcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -898,7 +898,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
@@ -906,7 +906,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "abcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -959,10 +959,10 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testcha
set x [list [gets $f] [testchannel inputbuffered $f]]
close $f
set x
-} [list "123456789012345" 15]
+} [list "123456789012345" 15]
test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
# PeekAhead() did not get any, so (eol >= dstEnd)
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -975,7 +975,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testc
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
# if (*eol == '\n') {skip++}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r\n78901"
@@ -986,8 +986,8 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r78901"
@@ -999,7 +999,7 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
# else if (*eol == '\n') {goto gotoeol;}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\n78901"
@@ -1092,7 +1092,7 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
@@ -1201,7 +1201,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x [gets $f]
close $f
- set x
+ set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
@@ -1217,7 +1217,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
- # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
@@ -1574,7 +1574,7 @@ test io-13.2 {TranslateInputEOL: crlf mode} {
set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1587,7 +1587,7 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1600,7 +1600,7 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1715,7 +1715,7 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
- # not (*src == '\r')
+ # not (*src == '\r')
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -2064,7 +2064,7 @@ test io-20.1 {Tcl_CreateChannel: initial settings} {
encoding system $old
close $a
set x
-} {ascii}
+} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
@@ -2159,7 +2159,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
-} {}
+} {}
# Test flushing. The functions tested here are FlushChannel.
@@ -3057,7 +3057,7 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
fconfigure $f -translation crlf
set x [read $f]
close $f
- set x
+ set x
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
file delete $path(test1)
@@ -3985,7 +3985,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
}
close $f
set f [open $path(test1) r]
- fconfigure $f -translation crlf
+ fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
append c $line\n
@@ -5474,7 +5474,7 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -encoding {}
+ fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
close $f
set f [open $path(test1) r]
@@ -5946,7 +5946,9 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
catch {close $f2}
catch {close $f3}
} -result {bad-write {}}
-test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs openpipe fileevent
+} -body {
set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
fileevent $f4 readable [namespace code {
if {[gets $f4 line] < 0} {
@@ -5959,9 +5961,10 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ close $f4
+} -result {initial foo eof}
close $f
makeFile "foo bar" foo
@@ -6719,8 +6722,9 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
+test io-50.1 {testing handler deletion} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6732,11 +6736,13 @@ test io-50.1 {testing handler deletion} {testchannelevent nonPortable} {
}
set z not_called
update
- close $f
set z
-} called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result called
+test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6749,12 +6755,14 @@ test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent
}
set z ""
update
- close $f
string compare [string tolower $z] \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
-} 0
-test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result 0
+test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6774,13 +6782,15 @@ test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent
}
set z ""
update
- close $f
string compare [string tolower $z] \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
-} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result 0
+test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6800,11 +6810,13 @@ test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent non
variable u toplevel
variable z ""
update
- close $f
set z
-} {{delrecursive calling recursive} {delrecursive deleting recursive}}
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+} -cleanup {
+ close $f
+} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6832,12 +6844,14 @@ test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent non
set z ""
set u toplevel
update
+ set z
+} -cleanup {
close $f
- set z
-} [list {del calling recursive} {del deleted notcalled} \
+} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent nonPortable} {
+test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent nonPortable} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
set f [open $path(test1) r]
@@ -6873,9 +6887,10 @@ test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent non
set z ""
set u toplevel
update
- close $f
set z
-} [list {first called} {first called not toplevel} \
+} -cleanup {
+ close $f
+} -result [list {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
{first after update}]
@@ -8648,11 +8663,11 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
interp create slave
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
- read [teststringobj get 1]
+ read [teststringobj get 1]
testobj duplicate 1 2
interp transfer {} $rfd slave
catch {read [teststringobj get 1]}
- read [teststringobj get 2]
+ read [teststringobj get 2]
} -cleanup {
interp delete slave
testobj freeallvars
--
cgit v0.12
From 35d0992797dc0bcdfae9edb823cb03c41bf37a5d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 3 Aug 2020 22:42:50 +0000
Subject: doc fix
---
doc/CrtAlias.3 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index 82ef122..10192e9 100644
--- a/doc/CrtAlias.3
+++ b/doc/CrtAlias.3
@@ -29,7 +29,7 @@ Tcl_Interp *
\fBTcl_GetMaster\fR(\fIinterp\fR)
.sp
int
-\fBTcl_GetInterpPath\fR(\finterp, slaveInterp\fR)
+\fBTcl_GetInterpPath\fR(\fIinterp, slaveInterp\fR)
.sp
int
\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
--
cgit v0.12
From 9557127009db74d0f4196e17d6cf1f536ef73547 Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Thu, 6 Aug 2020 13:09:22 +0000
Subject: Experiment with chan-io-50.6 on Travis
---
tests/chanio.test | 15 +++++++++++----
1 file changed, 11 insertions(+), 4 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index cdaf183..5266d57 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6497,9 +6497,6 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
set f [open $path(test1) w]
chan close $f
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
variable u
variable z
@@ -6529,11 +6526,21 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
+ # Testing why this test fails on Travis:
+ # The test appears to assume that select will not detect the
+ # new file until update is called.
+ lappend z "1"
+ set f [open $path(test1) r]
+ lappend z "2"
+ testchannelevent $f add readable [namespace code [list second $f]]
+ lappend z "3"
+ testchannelevent $f add readable [namespace code [list first $f]]
+ lappend z "update"
update
set z
} -cleanup {
chan close $f
-} -result [list {first called} {first called not toplevel} \
+} -result [list 1 2 3 update {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
{first after update}]
--
cgit v0.12
From f460900f9f25ca6b02f7e5de803eb63a84a2d12a Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Fri, 7 Aug 2020 13:12:21 +0000
Subject: Experiment with io-50.1 on Travis
---
tests/chanio.test | 11 ++++-------
tests/io.test | 9 +++++----
2 files changed, 9 insertions(+), 11 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index 5266d57..7ffe492 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6526,16 +6526,13 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
- # Testing why this test fails on Travis:
- # The test appears to assume that select will not detect the
- # new file until update is called.
- lappend z "1"
+ # This test assume that select will not detect the new open file
+ # until the update command runs. This is not guaranteed, but it
+ # seems to help if we make sure that the calls to testchannelevent
+ # immediately follow the call to open.
set f [open $path(test1) r]
- lappend z "2"
testchannelevent $f add readable [namespace code [list second $f]]
- lappend z "3"
testchannelevent $f add readable [namespace code [list first $f]]
- lappend z "update"
update
set z
} -cleanup {
diff --git a/tests/io.test b/tests/io.test
index 912f4c5..c9019af 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6725,17 +6725,18 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
test io-50.1 {testing handler deletion} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
- set f [open $path(test1) w]
- close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f]]
proc delhandler {f} {
variable z
set z called
testchannelevent $f delete 0
}
+ set f [open $path(test1) w]
+ close $f
set z not_called
update
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f]]
+ update
set z
} -cleanup {
close $f
--
cgit v0.12
From bb9b5e7606e6deecd6b7bfc7683be22d1c5c90b6 Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Fri, 7 Aug 2020 13:15:31 +0000
Subject: Fix the expected result for chanio-50.6
---
tests/chanio.test | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index 7ffe492..4f348f8 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6537,7 +6537,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
set z
} -cleanup {
chan close $f
-} -result [list 1 2 3 update {first called} {first called not toplevel} \
+} -result [list {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
{first after update}]
--
cgit v0.12
From 4b765a3aff40f73f918d159af41222d1ce972b24 Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Sat, 8 Aug 2020 21:27:06 +0000
Subject: Add and use testservicemode command; replace update by vwait
---
generic/tclTest.c | 52 ++++++++++++++++++++++++++++-
tests/chanio.test | 42 +++++++++++++++--------
tests/event.test | 1 +
tests/io.test | 99 ++++++++++++++++++++++++++++++++++---------------------
4 files changed, 141 insertions(+), 53 deletions(-)
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 37aafd2..fde7190 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -307,7 +307,7 @@ static Tcl_FSNormalizePathProc TestReportNormalizePath;
static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
-
+static Tcl_CmdProc TestServiceModeCmd;
static Tcl_FSStatProc SimpleStat;
static Tcl_FSAccessProc SimpleAccess;
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
@@ -561,6 +561,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
NULL, NULL);
+ Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
@@ -6049,6 +6051,54 @@ TestChannelEventCmd(
/*
*----------------------------------------------------------------------
*
+ * TestServiceModeCmd --
+ *
+ * This procedure implements the "testservicemode" command which gets or
+ * sets the current Tcl ServiceMode. There are several tests which open
+ * a file and assign various handlers to it. For these tests to be
+ * deterministic it is important that file events not be processed until
+ * all of the handlers are in place.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May change the ServiceMode setting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestServiceModeCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ const char **argv) /* Argument strings. */
+{
+ int newmode, oldmode;
+ if (argc > 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ?newmode?\"", NULL);
+ return TCL_ERROR;
+ }
+ oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE);
+ if (argc == 2) {
+ if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (newmode == 0) {
+ Tcl_SetServiceMode(TCL_SERVICE_NONE);
+ } else {
+ Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestWrongNumArgsObjCmd --
*
* Test the Tcl_WrongNumArgs function.
diff --git a/tests/chanio.test b/tests/chanio.test
index 4f348f8..c48fe63 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6394,14 +6394,16 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
chan close [open $path(test1) w]
set z ""
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
variable z
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
update
string equal $z \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
@@ -6411,11 +6413,8 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
- set z ""
+ update
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc notcalled {f i} {
variable z
lappend z "notcalled was called!! $f $i"
@@ -6427,6 +6426,12 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
testchannelevent $f delete 0
lappend z "delhandler $f $i deleted myself"
}
+ set z ""
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
update
string equal $z \
[list [list delhandler $f 0 called] \
@@ -6438,6 +6443,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
+ update
} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
@@ -6456,15 +6462,14 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
set z
} -cleanup {
chan close $f
+ update
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
+ update
} -constraints testchannelevent -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6480,22 +6485,31 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
} else {
set u recursive
lappend z "del calling recursive"
+ set mode [test servicemode 1]
update
+ test servicemode $mode
lappend z "del after update"
}
}
set z ""
set u toplevel
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testservicemode 1
+ testchannelevent $f add readable [namespace code [list del $f]]
update
set z
} -cleanup {
chan close $f
+ update
} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
+ update
} -constraints testchannelevent -body {
proc first {f} {
variable u
@@ -6503,7 +6517,9 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
if {$u eq "toplevel"} {
lappend z "first called"
set u first
+ set mode [testservicemode 1]
update
+ testservicemode $mode
lappend z "first after update"
} else {
lappend z "first called not toplevel"
@@ -6526,13 +6542,11 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
- # This test assume that select will not detect the new open file
- # until the update command runs. This is not guaranteed, but it
- # seems to help if we make sure that the calls to testchannelevent
- # immediately follow the call to open.
+ testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list second $f]]
testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
update
set z
} -cleanup {
diff --git a/tests/event.test b/tests/event.test
index 336c4e4..b42909c 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -33,6 +33,7 @@ test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
+ update idletasks
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
diff --git a/tests/io.test b/tests/io.test
index c9019af..cfa08ed 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6725,18 +6725,22 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
test io-50.1 {testing handler deletion} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
+ set f [open $path(test1) w]
+ close $f
+ update
proc delhandler {f} {
variable z
set z called
testchannelevent $f delete 0
}
- set f [open $path(test1) w]
- close $f
set z not_called
- update
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list delhandler $f]]
- update
+ testservicemode 1
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
@@ -6746,29 +6750,27 @@ test io-50.2 {testing handler deletion with multiple handlers} -constraints test
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
variable z
- lappend z "called delhandler $f $i"
+ lappend z "called delhandler $i"
testchannelevent $f delete 0
}
set z ""
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
update
- string compare [string tolower $z] \
- [list [list called delhandler $f 0] [list called delhandler $f 1]]
+ set z
} -cleanup {
close $f
-} -result 0
+} -result {{called delhandler 0} {called delhandler 1}}
test io-50.3 {testing handler deletion with multiple handlers} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
set z ""
proc notcalled {f i} {
variable z
@@ -6777,25 +6779,30 @@ test io-50.3 {testing handler deletion with multiple handlers} -constraints test
proc delhandler {f i} {
variable z
testchannelevent $f delete 1
- lappend z "delhandler $f $i called"
+ lappend z "delhandler $i called"
testchannelevent $f delete 0
- lappend z "delhandler $f $i deleted myself"
+ lappend z "delhandler $i deleted myself"
}
set z ""
- update
- string compare [string tolower $z] \
- [list [list delhandler $f 0 called] \
- [list delhandler $f 0 deleted myself]]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
close $f
-} -result 0
+} -result {{delhandler 0 called} {delhandler 0 deleted myself}}
test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
+ update
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ update
proc delrecursive {f} {
variable z
variable u
@@ -6810,7 +6817,13 @@ test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchan
}
variable u toplevel
variable z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
@@ -6820,9 +6833,6 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchan
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6832,40 +6842,48 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchan
variable z
if {"$u" == "recursive"} {
testchannelevent $f delete 1
- testchannelevent $f delete 0
lappend z "del deleted notcalled"
+ testchannelevent $f delete 0
lappend z "del deleted myself"
} else {
set u recursive
lappend z "del calling recursive"
- update
- lappend z "del after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "del after recursive"
}
}
set z ""
set u toplevel
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
+ testservicemode 1
+ set timer [after 50 set z timeout]
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
} -result [list {del calling recursive} {del deleted notcalled} \
- {del deleted myself} {del after update}]
+ {del deleted myself} {del after recursive}]
test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
variable u
variable z
if {"$u" == "toplevel"} {
lappend z "first called"
set u first
- update
- lappend z "first after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "first after toplevel"
} else {
lappend z "first called not toplevel"
}
@@ -6887,13 +6905,18 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchan
}
set z ""
set u toplevel
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
update
set z
} -cleanup {
close $f
} -result [list {first called} {first called not toplevel} \
{second called, first time} {second called, second time} \
- {first after update}]
+ {first after toplevel}]
test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set x 0
--
cgit v0.12
From 1cadacd498aa05465ad599e11c5deb0a913d1631 Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Sat, 8 Aug 2020 21:37:18 +0000
Subject: One more vwait.
---
tests/io.test | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/tests/io.test b/tests/io.test
index cfa08ed..a81e394 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6761,7 +6761,9 @@ test io-50.2 {testing handler deletion with multiple handlers} -constraints test
testchannelevent $f add readable [namespace code [list delhandler $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
testservicemode 1
- update
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
set z
} -cleanup {
close $f
--
cgit v0.12
From 5ed72038daa012a53d8b654d220d065b7bb3989c Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Sun, 9 Aug 2020 14:33:43 +0000
Subject: use vwait in chanio tests too.
---
tests/chanio.test | 36 ++++++++++++++++++++++++------------
1 file changed, 24 insertions(+), 12 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index c48fe63..97d5510 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6399,12 +6399,15 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
+ set z ""
+ set timer [after 50 lappend z timeout]
testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list delhandler $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
testservicemode 1
- update
+ vwait z
+ after cancel $timer
string equal $z \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
} -cleanup {
@@ -6413,7 +6416,6 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
- update
} -constraints testchannelevent -body {
proc notcalled {f i} {
variable z
@@ -6427,12 +6429,14 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
lappend z "delhandler $f $i deleted myself"
}
set z ""
+ set timer [after 50 lappend z timeout]
testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list notcalled $f 1]]
testchannelevent $f add readable [namespace code [list delhandler $f 0]]
testservicemode 1
- update
+ vwait z
+ after cancel $timer
string equal $z \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
@@ -6443,7 +6447,6 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
- update
} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
@@ -6458,7 +6461,9 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
}]
variable u toplevel
variable z ""
- update
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
set z
} -cleanup {
chan close $f
@@ -6485,20 +6490,24 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
} else {
set u recursive
lappend z "del calling recursive"
+ set timer [after 50 lappend z timeout]
set mode [test servicemode 1]
- update
+ vwait z
+ after cancel $timer
test servicemode $mode
lappend z "del after update"
}
}
set z ""
set u toplevel
+ set timer [after 50 lappend z timeout]
testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list notcalled $f]]
- testservicemode 1
testchannelevent $f add readable [namespace code [list del $f]]
- update
+ testservicemode 1
+ vwait z
+ after cancel $timer
set z
} -cleanup {
chan close $f
@@ -6509,16 +6518,17 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
- update
} -constraints testchannelevent -body {
proc first {f} {
variable u
variable z
if {$u eq "toplevel"} {
lappend z "first called"
- set u first
set mode [testservicemode 1]
- update
+ set timer [after 50 lappend z timeout]
+ set u first
+ vwait z
+ after cancel $timer
testservicemode $mode
lappend z "first after update"
} else {
@@ -6542,12 +6552,14 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
+ set timer [after 50 lappend z timeout]
testservicemode 0
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code [list second $f]]
testchannelevent $f add readable [namespace code [list first $f]]
testservicemode 1
- update
+ vwait z
+ after cancel $timer
set z
} -cleanup {
chan close $f
--
cgit v0.12
From 823d13656d0f81807f40c7029fcf4bf38215dedc Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Mon, 10 Aug 2020 01:27:37 +0000
Subject: More places where vwait needs to be used instead of update.
---
tests/chanio.test | 4 ++--
tests/io.test | 6 +++---
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index 97d5510..bc6bb1b 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5731,9 +5731,9 @@ test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileeven
chan event $f readable {}
}]
}
+ set timer [after 10 lappend x timeout]
testfevent cmd $script
- after 1 ;# We must delay because Windows takes a little time to notice
- update
+ vwait x
testfevent cmd {chan close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
diff --git a/tests/io.test b/tests/io.test
index a81e394..8c44db9 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6033,10 +6033,10 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
fileevent $f readable {}
}]
}
+ set timer [after 10 lappend x timeout]
testfevent cmd $script
- after 1 ;# We must delay because Windows takes a little time to notice
- update
- testfevent cmd {close $f}
+ vwait x
+ testfevent cmd {chan close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
--
cgit v0.12
From fd3f2b486c4c480c2fc90ae0a6845bfe0fb310a7 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 10 Aug 2020 14:57:19 +0000
Subject: Remove use of (always enabled) "openpipe" constraint. Add
"testservicemode" constraint. Change a single "chan close" into a "close" in
a test-case
---
tests/chanio.test | 144 ++++++++++++++++++++++++------------------------
tests/io.test | 160 +++++++++++++++++++++++++++---------------------------
2 files changed, 152 insertions(+), 152 deletions(-)
diff --git a/tests/chanio.test b/tests/chanio.test
index bc6bb1b..93375a0 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -39,10 +39,10 @@ namespace eval ::tcl::test::io {
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
- testConstraint openpipe 1
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
+ testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
# You need a *very* special environment to do some tests. In particular,
@@ -448,7 +448,7 @@ test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
} -cleanup {
chan close $f
} -result [list 256 $a]
-test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
+test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body {
# if (FilterInputBytes(chanPtr, &gs) != 0)
set f [openpipe w+ $path(cat)]
chan puts -nonewline $f "hi\nwould"
@@ -709,7 +709,7 @@ test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testc
} -result [list 15 "123456789012345" 15]
test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (FilterInputBytes() != 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {crlf lf} -buffering none
@@ -849,7 +849,7 @@ test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup {
} -result {4 abcd 4 efgh 4 ijkl 4 mnop -1 {}}
test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# if (chanPtr->flags & INPUT_SAW_CR)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -867,7 +867,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# not (*eol == '\n')
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -885,7 +885,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# Tcl_ExternalToUtf()
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -903,7 +903,7 @@ test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup
} -result {15 123456789abcdef 1 4 abcd 0}
test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# memmove()
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -1021,7 +1021,7 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -buffering none
chan puts -nonewline $f "foobar"
@@ -1088,7 +1088,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
@@ -1122,7 +1122,7 @@ test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constrai
} -result 7
test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
variable x {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# not (bufPtr->nextPtr == NULL)
set f [openpipe w+ $path(cat)]
chan configure $f -translation lf -encoding ascii -buffering none
@@ -1139,7 +1139,7 @@ test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
} -cleanup {
chan close $f
} -result {-1 {} 42 15 123456789012345 25}
-test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel fileevent} -body {
# (bytesLeft == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
@@ -1168,7 +1168,7 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
chan close $f
} -result $a
unset a
-test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel fileevent} -body {
# (bufPtr->nextAdded < bufPtr->length)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
@@ -1179,7 +1179,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {st
} -cleanup {
chan close $f
} -result {15 abcdefghijklmno 1}
-test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel fileevent} -body {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffersize 16
@@ -1192,7 +1192,7 @@ test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio te
} -result {15 abcdefghijklmno 1}
test chan-io-8.7 {PeekAhead: cleanup} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# Make sure bytes are removed from buffer.
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffering none
@@ -1343,7 +1343,7 @@ test chan-io-12.3 {ReadChars: allocate more space} -body {
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-12.4 {ReadChars: split-up char} -setup {
variable x {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (srcRead == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none -buffersize 16
@@ -1365,7 +1365,7 @@ test chan-io-12.4 {ReadChars: split-up char} -setup {
} -result [list "123456789012345" 1 "\u672c" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
chan gets stdin; chan puts -nonewline "\xe7"
@@ -1458,7 +1458,7 @@ test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
variable x {}
variable y {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
set f [openpipe w+ $path(cat)]
@@ -1476,7 +1476,7 @@ test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup
} -cleanup {
chan close $f
} -result [list "abcdefghj\n" 1 "01234" 0]
-test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints {testchannel openpipe} -body {
+test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints testchannel -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1577,7 +1577,7 @@ test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup {
interp delete x
} -result {line line none}
set path(test3) [makeFile {} test3]
-test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec openpipe} -body {
+test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints exec -body {
set f [open $path(test1) w]
chan puts -nonewline $f {
chan close stdin
@@ -1674,7 +1674,7 @@ set path(script) [makeFile {} script]
test chan-io-14.8 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stderr
@@ -1697,7 +1697,7 @@ test chan-io-14.8 {reuse of stdio special channels} -setup {
test chan-io-14.9 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [open $path(script) w]
chan puts $f {
array set path [lindex $argv 0]
@@ -1881,7 +1881,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
-} -constraints {stdio openpipe knownMsvcBug} -body {
+} -constraints {stdio knownMsvcBug} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -1966,7 +1966,7 @@ test chan-io-26.1 {Tcl_GetChannelInstanceData} -body {
# Don't care what pid is (but must be a number), just want to exercise it.
set f [openpipe r << exit]
pid $f
-} -constraints {stdio openpipe} -cleanup {
+} -constraints stdio -cleanup {
chan close $f
} -match regexp -result {^\d+$}
@@ -2041,7 +2041,7 @@ set path(output) [makeFile {} output]
test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close openpipe} -body {
+} -constraints {stdio asyncPipeChan Close} -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {
@@ -2111,7 +2111,7 @@ test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -se
test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close nonPortable openpipe} -body {
+} -constraints {stdio asyncPipeChan Close nonPortable} -body {
set f [open $path(pipe) w]
chan puts $f {
# Need to not have eof char appended on chan close, because the other
@@ -2165,7 +2165,7 @@ test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup {
} -result ok
test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
file delete $path(script)
-} -constraints {stdio unix testchannel openpipe} -body {
+} -constraints {stdio unix testchannel} -body {
set f [open $path(script) w]
chan puts $f {
chan close stdin
@@ -2382,7 +2382,7 @@ test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 "set f1 \[[list open $path(longfile) r]]"
chan puts $f1 {
@@ -2409,7 +2409,7 @@ test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts [chan gets stdin]
@@ -2462,7 +2462,7 @@ test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup {
} -match glob -result {channel "*" wasn't opened for writing}
test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} -setup {
set fd [openpipe r cat longfile]
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
chan flush $fd
} -returnCodes error -cleanup {
catch {chan close $fd}
@@ -2538,7 +2538,7 @@ test chan-io-29.20 {Implicit flush when buffer is full} -setup {
} -result {4096 12288 12600}
test chan-io-29.21 {Tcl_Flush to pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {set x [chan read stdin 6]}
chan puts $f1 {set cnt [string length $x]}
@@ -2553,7 +2553,7 @@ test chan-io-29.21 {Tcl_Flush to pipe} -setup {
} -result "read 6 characters"
test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan configure stdout -buffering full
@@ -2577,7 +2577,7 @@ test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
} -result {hello hello bye}
test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts hello
@@ -2614,7 +2614,7 @@ test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup {
} -result "{} {Line 1\nLine 2}"
test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
file delete $path(test3)
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)]
chan puts $f "Line 1"
chan puts $f "Line 2"
@@ -2625,7 +2625,7 @@ test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
} -cleanup {
chan close $f
} -result "Line 1\nLine 2\n"
-test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs openpipe} -body {
+test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs} -body {
set f [open "|[list cat -u]" r+]
chan puts $f "Line1"
chan flush $f
@@ -2638,7 +2638,7 @@ test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup {
set f [open $path(pipe) w]
chan puts $f {exit}
chan close $f
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [openpipe r+ $path(pipe)]
chan gets $f
chan puts $f output
@@ -2691,7 +2691,7 @@ test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -2732,7 +2732,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close openpipe} -body {
+} -constraints {stdio asyncPipeChan Close} -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -4005,7 +4005,7 @@ test chan-io-32.9 {Tcl_Read, read to end of file} {
} ok
test chan-io-32.10 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
@@ -4019,7 +4019,7 @@ test chan-io-32.10 {Tcl_Read from a pipe} -setup {
test chan-io-32.11 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan puts $f1 {chan puts [chan gets stdin]}
@@ -4131,7 +4131,7 @@ test chan-io-33.2 {Tcl_Gets into variable} {
} ok
test chan-io-33.3 {Tcl_Gets from pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
@@ -4341,7 +4341,7 @@ test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position
} -result {44 rstuv 49}
test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup {
set pipe [openpipe]
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
chan seek $pipe 0 current
} -returnCodes error -cleanup {
chan close $pipe
@@ -4451,13 +4451,13 @@ test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
} -cleanup {
chan close $f1
} -result {10 20}
-test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints {stdio openpipe} -body {
+test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints stdio -body {
set f1 [openpipe]
chan tell $f1
} -cleanup {
chan close $f1
} -result -1
-test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test chan-io-34.17 {Tcl_Tell on pipe: always -1} stdio {
set f1 [openpipe]
chan puts $f1 {chan puts hello}
chan flush $f1
@@ -4559,7 +4559,7 @@ test chan-io-35.1 {Tcl_Eof} -setup {
} -cleanup {
chan close $f
} -result {0 0 0 0 1 1}
-test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+test chan-io-35.2 {Tcl_Eof with pipe} -constraints stdio -setup {
file delete $path(pipe)
} -body {
set f1 [open $path(pipe) w]
@@ -4578,7 +4578,7 @@ test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
} -cleanup {
chan close $f1
} -result {0 0 0 1}
-test chan-io-35.3 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+test chan-io-35.3 {Tcl_Eof with pipe} -constraints stdio -setup {
file delete $path(pipe)
} -body {
set f1 [open $path(pipe) w]
@@ -4616,7 +4616,7 @@ test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup {
test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup {
file delete $path(pipe)
set l ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(pipe) w]
chan puts $f {
exit
@@ -4801,7 +4801,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [openpipe]
chan puts $f1 {chan puts hello_from_pipe}
chan flush $f1
@@ -4821,7 +4821,7 @@ test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
} -result {{} 1 hello 0 {} 1}
test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup {
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [openpipe]
chan configure $f1 -buffering line
chan puts $f1 {chan puts hello_from_pipe}
@@ -5095,7 +5095,7 @@ test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup {
test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup {
file delete $path(pipe)
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan gets stdin
@@ -5192,7 +5192,7 @@ test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
chan puts -nonewline $f "\xe7"
@@ -5552,7 +5552,7 @@ test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
set result {}
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
chan event $f r "chan read f"
chan event $f2 r "chan read f2"
@@ -5572,7 +5572,7 @@ test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
test chan-io-44.1 {FileEventProc procedure: normal read event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 readable [namespace code {
set x [chan gets $f2]; chan event $f2 readable {}
}]
@@ -5592,7 +5592,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 readable {error bogus}
chan puts $f2 text; chan flush $f2
variable x initial
@@ -5606,7 +5606,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
test chan-io-44.3 {FileEventProc procedure: normal write event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5632,7 +5632,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 writable {error bad-write}
variable x initial
vwait [namespace which -variable x]
@@ -5643,7 +5643,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
catch {chan close $f3}
} -result {bad-write {}}
test chan-io-44.5 {FileEventProc procedure: end of file} -constraints {
- stdio unixExecs openpipe fileevent
+ stdio unixExecs fileevent
} -body {
set f4 [openpipe r $path(cat) << foo]
chan event $f4 readable [namespace code {
@@ -5921,7 +5921,7 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
set path(my_script) [makeFile {} my_script]
test chan-io-48.3 {testing readability conditions} -setup {
set l ""
-} -constraints {stdio unix nonBlockFiles openpipe fileevent} -body {
+} -constraints {stdio unix nonBlockFiles fileevent} -body {
set f [open $path(bar) w]
chan puts $f abcdefg
chan puts $f abcdefg
@@ -6393,7 +6393,7 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints testchannelevent -body {
+} -constraints {testchannelevent testservicemode} -body {
proc delhandler {f i} {
variable z
lappend z "called delhandler $f $i"
@@ -6416,7 +6416,7 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
-} -constraints testchannelevent -body {
+} -constraints {testchannelevent testservicemode} -body {
proc notcalled {f i} {
variable z
lappend z "notcalled was called!! $f $i"
@@ -6474,7 +6474,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
set f [open $path(test1) w]
chan close $f
update
-} -constraints testchannelevent -body {
+} -constraints {testchannelevent testservicemode} -body {
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6518,7 +6518,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints testchannelevent -body {
+} -constraints {testchannelevent testservicemode} -body {
proc first {f} {
variable u
variable z
@@ -6742,7 +6742,7 @@ test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
test chan-io-52.8 {TclCopyChannel} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set f1 [open $path(pipe) w]
chan configure $f1 -translation lf
chan puts $f1 "
@@ -6863,7 +6863,7 @@ test chan-io-53.2 {CopyData} -setup {
test chan-io-53.3 {CopyData: background read underflow} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio unix openpipe fcopy} -body {
+} -constraints {stdio unix fcopy} -body {
set f1 [open $path(pipe) w]
chan puts -nonewline $f1 {
chan puts ready
@@ -6901,7 +6901,7 @@ test chan-io-53.4 {CopyData: background write overflow} -setup {
}
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio unix openpipe fileevent fcopy} -body {
+} -constraints {stdio unix fileevent fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts ready
@@ -6965,7 +6965,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup {
file delete $path(pipe)
file delete $path(test1)
catch {unset fcopyTestDone}
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 "exit 1"
chan close $f1
@@ -6999,7 +6999,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
variable fcopyTestDone
file delete $path(pipe)
catch {unset fcopyTestDone}
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set fcopyTestCount 0
set f1 [open $path(pipe) w]
chan puts $f1 {
@@ -7049,7 +7049,7 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Record input size, so that result is always defined
lappend ::RES [file size $bar]
# Run the copy. Should not invoke -command now.
@@ -7089,7 +7089,7 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at
# Channels to copy between
set f [open $foo r] ; chan configure $f -translation binary
set g [open $bar w] ; chan configure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Initialize and force eof on the input.
chan seek $f 0 end ; chan read $f 1
set ::RES [chan eof $f]
@@ -7147,7 +7147,7 @@ test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
}
set ::forever {}
set out [open $out w]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
chan copy $pipe $out -size 6 -command ::done
set token [after 5000 {
set ::forever {fcopy hangs}
@@ -7220,7 +7220,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
chan configure $b -translation binary -buffering none
chan event $a readable [namespace code "done $a"]
chan event $b readable [namespace code "done $b"]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
chan puts $a AB
@@ -7442,7 +7442,7 @@ test chan-io-57.2 {buffered data and file events, read} -setup {
chan close $server
} -result {1 readable 234567890 timer}
-test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
+test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
set out [open $path(script) w]
chan puts $out {
chan puts "normal message from pipe"
@@ -7480,7 +7480,7 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
string equal $result [testmainthread]
} {1}
-test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
+test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
diff --git a/tests/io.test b/tests/io.test
index 8c44db9..0db6afb 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -38,11 +38,11 @@ namespace eval ::tcl::test::io {
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
-testConstraint openpipe 1
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testobj [llength [info commands testobj]]
+testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
# You need a *very* special environment to do some tests. In
@@ -481,7 +481,7 @@ test io-6.6 {Tcl_GetsObj: loop test} {
close $f
set x
} [list 256 $a]
-test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
+test io-6.7 {Tcl_GetsObj: error in input} stdio {
# if (FilterInputBytes(chanPtr, &gs) != 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -741,7 +741,7 @@ test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
close $f
set x
} [list 15 "123456789012345" 15]
-test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
+test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel fileevent} {
# (FilterInputBytes() != 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -880,7 +880,7 @@ test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
close $f
set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
-test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
+test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} {
# if (chanPtr->flags & INPUT_SAW_CR)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -897,7 +897,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
+test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} {
# not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -914,7 +914,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
+test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} {
# Tcl_ExternalToUtf()
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -931,7 +931,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio test
close $f
set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
-test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
+test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel fileevent} {
# memmove()
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1056,7 +1056,7 @@ test io-6.55 {Tcl_GetsObj: overconverted} {
close $f
set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
-test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
+test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
update
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -buffering none
@@ -1116,7 +1116,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
close $f
set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
-test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
+test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
@@ -1151,7 +1151,7 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel}
close $f
set x
} "7"
-test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
+test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel fileevent} {
# not (bufPtr->nextPtr == NULL)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1171,7 +1171,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha
close $f
set x
} [list -1 "" 42 15 "123456789012345" 25]
-test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
+test io-8.3 {PeekAhead: no cached data available} {stdio testchannel fileevent} {
# (bytesLeft == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1204,7 +1204,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x
} $a
unset a
-test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
+test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fileevent} {
# (bufPtr->nextAdded < bufPtr->length)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1216,7 +1216,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
+test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileevent} {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1228,7 +1228,7 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
+test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} {
# Make sure bytes are removed from buffer.
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1393,7 +1393,7 @@ test io-12.3 {ReadChars: allocate more space} {
close $f
set x
} {abcdefghijklmnopqrstuvwxyz}
-test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
+test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
# (srcRead == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1418,7 +1418,7 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
close $f
set x
} [list "123456789012345" 1 "\u672c" 0]
-test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} {
+test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
gets stdin; puts -nonewline "\xe7"
@@ -1612,7 +1612,7 @@ test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
close $f
set x
} "abcd\ndef\nfgh"
-test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
+test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel fileevent} {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
@@ -1638,7 +1638,7 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testc
close $f
set x
} [list "abcdefghj\n" 1 "01234" 0]
-test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
+test io-13.7 {TranslateInputEOL: auto mode: naked \r} testchannel {
# (src >= srcMax)
set f [open $path(test1) w]
@@ -1783,7 +1783,7 @@ test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
set l
} {line line none}
set path(test3) [makeFile {} test3]
-test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
+test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec {
set f [open $path(test1) w]
puts -nonewline $f {
close stdin
@@ -1873,7 +1873,7 @@ test io-14.7 {Tcl_GetChannel: stdio name translation} {
set result
} {{} {} {can not find channel named "stderr"}}
set path(script) [makeFile {} script]
-test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
+test io-14.8 {reuse of stdio special channels} stdio {
file delete $path(script)
file delete $path(test1)
set f [open $path(script) w]
@@ -1895,7 +1895,7 @@ test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
close $f
set c
} hello
-test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
+test io-14.9 {reuse of stdio special channels} {stdio fileevent} {
file delete $path(script)
file delete $path(test1)
set f [open $path(script) w]
@@ -2078,7 +2078,7 @@ test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
set x
} {{{} {}} {auto lf}}
set path(stdout) [makeFile {} stdout]
-test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
+test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio {
set f [open $path(script) w]
puts -nonewline $f {
close stdout
@@ -2152,7 +2152,7 @@ test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
set l
} {6 6 0 6}
-test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
+test io-26.1 {Tcl_GetChannelInstanceData} stdio {
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
@@ -2229,7 +2229,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
- {stdio asyncPipeClose openpipe knownMsvcBug} {
+ {stdio asyncPipeClose knownMsvcBug} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2298,7 +2298,7 @@ test io-28.2 {CloseChannel called when all references are dropped} {
set l
} abcdef
test io-28.3 {CloseChannel, not called before output queue is empty} \
- {stdio asyncPipeClose nonPortable openpipe} {
+ {stdio asyncPipeClose nonPortable} {
file delete $path(pipe)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2355,7 +2355,7 @@ test io-28.4 {Tcl_Close} {testchannel} {
$consoleFileNames]
string compare $l $x
} 0
-test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} {
+test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -2494,7 +2494,7 @@ test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
close $f2
file size $path(test1)
} 377
-test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
+test io-29.12 {Tcl_WriteChars on a pipe} stdio {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -2519,7 +2519,7 @@ test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
close $f2
set y
} ok
-test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
+test io-29.13 {Tcl_WriteChars to a pipe, line buffered} stdio {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -2570,7 +2570,7 @@ test io-29.15 {Tcl_Flush, channel not open for writing} {
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
-test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
+test io-29.16 {Tcl_Flush on pipe opened only for reading} stdio {
set fd [open "|[list [interpreter] cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
@@ -2644,7 +2644,7 @@ test io-29.20 {Implicit flush when buffer is full} {
lappend z [file size $path(test1)]
set z
} {4096 12288 12600}
-test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
+test io-29.21 {Tcl_Flush to pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {set x [read stdin 6]}
@@ -2658,7 +2658,7 @@ test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
catch {close $f1}
set x
} "read 6 characters"
-test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
+test io-29.22 {Tcl_Flush called at other end of pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -2681,7 +2681,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
close $f1
set x
} {hello hello bye}
-test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
+test io-29.23 {Tcl_Flush and line buffering at end of pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -2716,7 +2716,7 @@ test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
close $f
set x
} "{} {Line 1\nLine 2}"
-test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
+test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileevent} {
file delete $path(test3)
set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
puts $f "Line 1"
@@ -2728,7 +2728,7 @@ test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpi
close $f
set x
} "Line 1\nLine 2\n"
-test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
+test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
set f [open "|[list cat -u]" r+]
puts $f "Line1"
flush $f
@@ -2736,7 +2736,7 @@ test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs
close $f
set x
} {Line1}
-test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
+test io-29.27 {Tcl_Flush on closed pipeline} stdio {
file delete $path(pipe)
set f [open $path(pipe) w]
puts $f {exit}
@@ -2790,7 +2790,7 @@ test io-29.30 {Tcl_WriteChars, crlf mode} {
close $f
file size $path(test1)
} 25
-test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+test io-29.31 {Tcl_WriteChars, background flush} stdio {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2833,7 +2833,7 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
set result
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
- {stdio asyncPipeClose openpipe knownMsvcBug} {
+ {stdio asyncPipeClose knownMsvcBug} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -4093,7 +4093,7 @@ test io-32.9 {Tcl_Read, read to end of file} {
}
set x
} ok
-test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.10 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4105,7 +4105,7 @@ test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
close $f1
set x
} "hello\n"
-test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4124,7 +4124,7 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
-test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11.1 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {chan configure stdout -translation crlf}
@@ -4144,7 +4144,7 @@ test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
-test io-32.11.2 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11.2 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {chan configure stdout -translation crlf}
@@ -4255,7 +4255,7 @@ test io-33.2 {Tcl_Gets into variable} {
close $f1
set z
} ok
-test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
+test io-33.3 {Tcl_Gets from pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4563,7 +4563,7 @@ test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
close $f1
list $c1 $r1 $c2
} {44 rstuv 49}
-test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
+test io-34.8 {Tcl_Seek on pipes: not supported} stdio {
set f1 [open "|[list [interpreter]]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
@@ -4671,13 +4671,13 @@ test io-34.15 {Tcl_Tell combined with seeking} {
close $f1
list $c1 $c2
} {10 20}
-test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test io-34.16 {Tcl_Tell on pipe: always -1} stdio {
set f1 [open "|[list [interpreter]]" r+]
set c [tell $f1]
close $f1
set c
} -1
-test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test io-34.17 {Tcl_Tell on pipe: always -1} stdio {
set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello}
flush $f1
@@ -4776,7 +4776,7 @@ test io-35.1 {Tcl_Eof} {
close $f
set x
} {0 0 0 0 1 1}
-test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
+test io-35.2 {Tcl_Eof with pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
@@ -4794,7 +4794,7 @@ test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
close $f1
set x
} {0 0 0 1}
-test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
+test io-35.3 {Tcl_Eof with pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
@@ -4828,7 +4828,7 @@ test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
close $f
set l
} {{} 1}
-test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
+test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio {
file delete $path(pipe)
set f [open $path(pipe) w]
puts $f {
@@ -5105,7 +5105,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
# Test Tcl_InputBlocked
-test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
+test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
@@ -5124,7 +5124,7 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
+test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
chan configure $f1 -encoding binary -translation lf -eofchar {}
puts $f1 {
@@ -5147,7 +5147,7 @@ test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
+test io-36.2 {Tcl_InputBlocked on blocking pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
@@ -5411,7 +5411,7 @@ test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
close $f1
set x
} {1 0 {} {} 0 1}
-test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
+test io-39.10 {Tcl_SetChannelOption, blocking mode} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -5502,7 +5502,7 @@ test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
close $f
set result
} {1 {unknown encoding "foobar"}}
-test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
+test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xe7"
@@ -5851,7 +5851,7 @@ test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs f
test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
set result {}
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
fileevent $f r "read f"
@@ -5872,7 +5872,7 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
test io-44.1 {FileEventProc procedure: normal read event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
fileevent $f2 readable [namespace code {
set x [gets $f2]; fileevent $f2 readable {}
}]
@@ -5885,7 +5885,7 @@ test io-44.1 {FileEventProc procedure: normal read event} -setup {
catch {close $f3}
} -result {text}
test io-44.2 {FileEventProc procedure: error in read event} -constraints {
- stdio unixExecs fileevent openpipe
+ stdio unixExecs fileevent
} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
@@ -5908,7 +5908,7 @@ test io-44.2 {FileEventProc procedure: error in read event} -constraints {
test io-44.3 {FileEventProc procedure: normal write event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
fileevent $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5927,7 +5927,7 @@ test io-44.3 {FileEventProc procedure: normal write event} -setup {
catch {close $f3}
} -result {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
- stdio unixExecs fileevent openpipe
+ stdio unixExecs fileevent
} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
@@ -5947,7 +5947,7 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
catch {close $f3}
} -result {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} -constraints {
- stdio unixExecs openpipe fileevent
+ stdio unixExecs fileevent
} -body {
set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
fileevent $f4 readable [namespace code {
@@ -6036,7 +6036,7 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
set timer [after 10 lappend x timeout]
testfevent cmd $script
vwait x
- testfevent cmd {chan close $f}
+ testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
@@ -6224,7 +6224,7 @@ test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
list $x $l
} {done {called called called called called called called}}
set path(my_script) [makeFile {} my_script]
-test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} {
+test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileevent} {
set f [open $path(bar) w]
puts $f abcdefg
puts $f abcdefg
@@ -6722,7 +6722,7 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} -constraints testchannelevent -setup {
+test io-50.1 {testing handler deletion} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
@@ -6745,7 +6745,7 @@ test io-50.1 {testing handler deletion} -constraints testchannelevent -setup {
} -cleanup {
close $f
} -result called
-test io-50.2 {testing handler deletion with multiple handlers} -constraints testchannelevent -setup {
+test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
@@ -6768,7 +6768,7 @@ test io-50.2 {testing handler deletion with multiple handlers} -constraints test
} -cleanup {
close $f
} -result {{called delhandler 0} {called delhandler 1}}
-test io-50.3 {testing handler deletion with multiple handlers} -constraints testchannelevent -setup {
+test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
@@ -6798,7 +6798,7 @@ test io-50.3 {testing handler deletion with multiple handlers} -constraints test
} -cleanup {
close $f
} -result {{delhandler 0 called} {delhandler 0 deleted myself}}
-test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
+test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
update
} -body {
@@ -6830,7 +6830,7 @@ test io-50.4 {testing handler deletion vs reentrant calls} -constraints testchan
} -cleanup {
close $f
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
-test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
+test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
@@ -6871,7 +6871,7 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchan
close $f
} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after recursive}]
-test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup {
+test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
@@ -7109,7 +7109,7 @@ test io-52.7 {TclCopyChannel} {fcopy} {
}
set result
} {0 0 ok}
-test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
+test io-52.8 {TclCopyChannel} {stdio fcopy} {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -7389,7 +7389,7 @@ test io-53.2 {CopyData} {fcopy} {
}
set result
} {0 0 ok}
-test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
+test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -7421,7 +7421,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
close $f
set result
} "ready line1 line2 {done\n}"
-test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} {
+test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
variable x
for {set x 0} {$x < 12} {incr x} {
@@ -7512,7 +7512,7 @@ test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
close $out
set fcopyTestDone ;# 1 for error condition
} 1
-test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} {
+test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
file delete $path(test1)
@@ -7545,7 +7545,7 @@ proc doFcopy {in out {bytes 0} {error {}}} {
-command [namespace code [list doFcopy $in $out]]]
}
}
-test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
+test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
catch {unset fcopyTestDone}
@@ -7597,7 +7597,7 @@ test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Record input size, so that result is always defined
lappend ::RES [file size $bar]
# Run the copy. Should not invoke -command now.
@@ -7638,7 +7638,7 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof}
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Initialize and force eof on the input.
seek $f 0 end ; read $f 1
set ::RES [eof $f]
@@ -7678,7 +7678,7 @@ test io-53.8b {CopyData: async callback and -size 0} -setup {
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set ::RES {}
# Run the copy. Should not invoke -command now.
fcopy $f $g -size 0 -command ::cmd
@@ -7735,7 +7735,7 @@ test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
}
set ::forever {}
set out [open $out w]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
fcopy $pipe $out -size 6 -command ::done
set token [after 5000 {
set ::forever {fcopy hangs}
@@ -7805,7 +7805,7 @@ test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
fconfigure $b -translation binary -buffering none
fileevent $a readable [list ::done $a]
fileevent $b readable [list ::done $b]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
puts $a AB
@@ -7853,7 +7853,7 @@ test io-53.11 {Bug 2895565} -setup {
removeFile out
removeFile in
} -result {40 bytes copied}
-test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix openpipe fcopy} {
+test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts -nonewline $f1 {
@@ -8268,7 +8268,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
set result
} {1 readable 234567890 timer}
-test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
+test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
set out [open $path(script) w]
puts $out {
puts "normal message from pipe"
@@ -8308,7 +8308,7 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
string equal $result [testmainthread]
} {1}
-test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
+test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
--
cgit v0.12
From 3cd49200d7d04605090a8dbaba57a127b785ceb5 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Mon, 10 Aug 2020 16:16:36 +0000
Subject: windows: replace gethostbyname with getaddrinfo (gethostbyname can
hang sporadically, closes [7cf7cce423]); corresponding to MS
(https://docs.microsoft.com/en-us/windows/win32/api/winsock/nf-winsock-gethostbyname):
Developers creating Windows Sockets 2 applications are urged to use the
getaddrinfo function instead of gethostbyname
---
win/tclWinSock.c | 102 +++++++++++++++++++++++++++++++------------------------
1 file changed, 58 insertions(+), 44 deletions(-)
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 882aa4a..11632c4 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -45,6 +45,8 @@
* SocketCheckProc().
*/
+#include <winsock2.h>
+#include <ws2tcpip.h>
#include "tclWinInt.h"
#ifdef _MSC_VER
@@ -187,8 +189,8 @@ static WNDCLASS windowClass;
static SocketInfo * CreateSocket(Tcl_Interp *interp, int port,
const char *host, int server, const char *myaddr,
int myport, int async);
-static int CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
- const char *host, int port);
+static int CreateSocketAddress(struct sockaddr_in *sockaddrPtr,
+ const char *host, int port, int willBind);
static void InitSockets(void);
static SocketInfo * NewSocketInfo(SOCKET socket);
static void SocketExitHandler(ClientData clientData);
@@ -917,8 +919,8 @@ CreateSocket(
* asynchronously. */
{
u_long flag = 1; /* Indicates nonblocking mode. */
- SOCKADDR_IN sockaddr; /* Socket address */
- SOCKADDR_IN mysockaddr; /* Socket address for client */
+ struct sockaddr_in sockaddr; /* Socket address */
+ struct sockaddr_in mysockaddr; /* Socket address for client */
SOCKET sock = INVALID_SOCKET;
SocketInfo *infoPtr=NULL; /* The returned value. */
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
@@ -934,11 +936,11 @@ CreateSocket(
return NULL;
}
- if (!CreateSocketAddress(&sockaddr, host, port)) {
+ if (!CreateSocketAddress(&sockaddr, host, port, server)) {
goto error;
}
if ((myaddr != NULL || myport != 0) &&
- !CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+ !CreateSocketAddress(&mysockaddr, myaddr, myport, 1)) {
goto error;
}
@@ -1149,55 +1151,67 @@ static int
CreateSocketAddress(
LPSOCKADDR_IN sockaddrPtr, /* Socket address */
const char *host, /* Host. NULL implies INADDR_ANY */
- int port) /* Port number */
+ int port, /* Port number */
+ int willBind) /* Is this an address to bind() to or
+ * to connect() to? */
{
- struct hostent *hostent; /* Host database entry */
- struct in_addr addr; /* For 64/32 bit madness */
+ struct addrinfo hints, *resPtr = NULL;
+ char *native;
+ Tcl_DString ds;
+ int result;
+
+ if (host == NULL) {
+ sockaddrPtr->sin_family = AF_INET;
+ sockaddrPtr->sin_addr.s_addr = INADDR_ANY;
+ addPort:
+ sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
+ return 1;
+ }
+
+ (void) memset(&hints, 0, sizeof(struct addrinfo));
+ hints.ai_family = AF_INET;
+ hints.ai_socktype = SOCK_STREAM;
+ if (willBind) {
+ hints.ai_flags |= AI_PASSIVE;
+ }
/*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
+ * Note that getaddrinfo() *is* thread-safe. If a platform doesn't get
+ * that right, it shouldn't use this part of the code.
*/
- if (!SocketsEnabled()) {
- Tcl_SetErrno(EFAULT);
- return 0;
+ native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
+ result = getaddrinfo(native, NULL, &hints, &resPtr);
+ Tcl_DStringFree(&ds);
+ if (result == 0) {
+ memcpy(sockaddrPtr, resPtr->ai_addr, sizeof(struct sockaddr_in));
+ freeaddrinfo(resPtr);
+ goto addPort;
}
- ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
- sockaddrPtr->sin_family = AF_INET;
- sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
- if (host == NULL) {
- addr.s_addr = INADDR_ANY;
- } else {
- addr.s_addr = inet_addr(host);
- if (addr.s_addr == INADDR_NONE) {
- hostent = gethostbyname(host);
- if (hostent != NULL) {
- memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
- } else {
+ /*
+ * errno corresponding result ...
+ */
+
+ switch (result) {
+ case EAI_NONAME:
+ case EAI_SERVICE:
+#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
+ case EAI_ADDRFAMILY:
+#endif
+#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
+ case EAI_NODATA:
+#endif
#ifdef EHOSTUNREACH
- Tcl_SetErrno(EHOSTUNREACH);
-#else
-#ifdef ENXIO
- Tcl_SetErrno(ENXIO);
+ Tcl_SetErrno(EHOSTUNREACH);
+ return 0;
#endif
+ default:
+#ifdef ENXIO
+ Tcl_SetErrno(ENXIO);
#endif
- return 0; /* Error. */
- }
- }
+ return 0;
}
-
- /*
- * NOTE: On 64 bit machines the assignment below is rumored to not do the
- * right thing. Please report errors related to this if you observe
- * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
- * modify this code to do an explicit memcpy?
- */
-
- sockaddrPtr->sin_addr.s_addr = addr.s_addr;
- return 1; /* Success. */
}
/*
--
cgit v0.12
From f397a9ac9d2bc4a067fdc01f1e08188db53f5f93 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Mon, 10 Aug 2020 16:16:46 +0000
Subject: create server socket with AI_PASSIVE flag (used for bind)
---
unix/tclUnixChan.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index d3207e2..39bb64f 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -2378,7 +2378,7 @@ CreateSocket(
const char *errorMsg = NULL;
sock = -1;
- if (!CreateSocketAddress(&sockaddr, host, port, 0, &errorMsg)) {
+ if (!CreateSocketAddress(&sockaddr, host, port, server, &errorMsg)) {
goto addressError;
}
if ((myaddr != NULL || myport != 0) &&
--
cgit v0.12
From 6c0be70d2b1cc5dbfd1277556ac27ea2e39be4bb Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Mon, 10 Aug 2020 16:54:46 +0000
Subject: amend to [8054e19451]: clean up timeout timer event (avoid timing
issues on further tests)
---
tests/chanio.test | 1 +
tests/io.test | 1 +
2 files changed, 2 insertions(+)
diff --git a/tests/chanio.test b/tests/chanio.test
index 93375a0..66f4a30 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5734,6 +5734,7 @@ test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileeven
set timer [after 10 lappend x timeout]
testfevent cmd $script
vwait x
+ after cancel $timer
testfevent cmd {chan close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
diff --git a/tests/io.test b/tests/io.test
index 0db6afb..685394c 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6036,6 +6036,7 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
set timer [after 10 lappend x timeout]
testfevent cmd $script
vwait x
+ after cancel $timer
testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
--
cgit v0.12
From e29e808f57505a56193de6e0717c7abe95755b03 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 10 Aug 2020 18:05:10 +0000
Subject: Fix for [29e8848eb976], imported alias in a deletion trace.
---
generic/tclBasic.c | 3 ++-
generic/tclInt.h | 1 +
tests/namespace.test | 43 +++++++++++++++++++++++++++++++++++++++++++
3 files changed, 46 insertions(+), 1 deletion(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fe64f18..f52ecf5 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3268,6 +3268,7 @@ Tcl_DeleteCommandFromToken(
* TclNRExecuteByteCode looks up the command in the command hashtable).
*/
+ cmdPtr->flags |= CMD_IS_DELETED;
TclCleanupCommandMacro(cmdPtr);
return 0;
}
@@ -4331,7 +4332,7 @@ EvalObjvCore(
* Caller gave it to us.
*/
- if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
+ if (!(preCmdPtr->flags & CMD_DEAD)) {
/*
* So long as it exists, use it.
*/
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 31108c7..1e90b70 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1682,6 +1682,7 @@ typedef struct Command {
#define CMD_COMPILES_EXPANDED 0x08
#define CMD_REDEF_IN_PROGRESS 0x10
#define CMD_VIA_RESOLVER 0x20
+#define CMD_DEAD 0x30
/*
diff --git a/tests/namespace.test b/tests/namespace.test
index dd71697..796b46b 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3337,6 +3337,49 @@ test namespace-56.5 {Bug 8b9854c3d8} -setup {
namespace delete namespace-56.5
} -result 1
+
+
+test namespace-57.0 {
+ an imported alias should be usable in the deletion trace for the alias
+
+ see 29e8848eb976
+} -body {
+ variable res {}
+ namespace eval ns2 {
+ namespace export *
+ proc p1 {oldname newname op} {
+ return success
+ }
+
+ interp alias {} [namespace current]::p2 {} [namespace which p1]
+ }
+
+
+ namespace eval ns3 {
+ namespace import ::ns2::p2
+ }
+
+
+ set ondelete [list apply [list {oldname newname op} {
+ variable res
+ catch {
+ ns3::p2 $oldname $newname $op
+ } cres
+ lappend res $cres
+ } [namespace current]]]
+
+
+ trace add command ::ns2::p2 delete $ondelete
+ rename ns2::p2 {}
+ return $res
+} -cleanup {
+ unset res
+ namespace delete ns2
+ namespace delete ns3
+} -result success
+
+
+
# cleanup
catch {rename cmd1 {}}
--
cgit v0.12
From 36d06e1e0b240999e478c750f746a86dbd63caae Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 10 Aug 2020 19:33:18 +0000
Subject: Fix mistake in [7eed2baf73]
---
generic/tclBasic.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f52ecf5..50bc84e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3268,7 +3268,7 @@ Tcl_DeleteCommandFromToken(
* TclNRExecuteByteCode looks up the command in the command hashtable).
*/
- cmdPtr->flags |= CMD_IS_DELETED;
+ cmdPtr->flags |= CMD_DEAD;
TclCleanupCommandMacro(cmdPtr);
return 0;
}
--
cgit v0.12
From d73c6dbd81c0537e3d6df60dc145af1b6539d6d2 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 11 Aug 2020 05:39:08 +0000
Subject: Eliminate many unnecessary type-casts, mostly (size_t) when value is
already size_t or int
---
generic/tclAlloc.c | 2 +-
generic/tclBasic.c | 2 +-
generic/tclBinary.c | 16 ++++++++--------
generic/tclCkalloc.c | 6 +++---
generic/tclCmdMZ.c | 4 ++--
generic/tclCompCmdsSZ.c | 2 +-
generic/tclCompExpr.c | 2 +-
generic/tclCompile.c | 8 ++++----
generic/tclExecute.c | 4 ++--
generic/tclFileName.c | 2 +-
generic/tclIO.c | 6 +++---
generic/tclIOUtil.c | 2 +-
generic/tclInterp.c | 8 ++++----
generic/tclListObj.c | 6 +++---
generic/tclObj.c | 12 ++++++------
generic/tclPathObj.c | 2 +-
generic/tclStubInit.c | 2 +-
generic/tclThread.c | 4 ++--
generic/tclThreadTest.c | 4 ++--
generic/tclTrace.c | 4 ++--
macosx/tclMacOSXFCmd.c | 2 +-
unix/tclUnixFile.c | 2 +-
unix/tclUnixInit.c | 4 ++--
unix/tclUnixSock.c | 2 +-
win/tclWinConsole.c | 6 +++---
win/tclWinFCmd.c | 2 +-
win/tclWinInit.c | 4 ++--
win/tclWinPipe.c | 2 +-
win/tclWinSerial.c | 2 +-
win/tclWinSock.c | 2 +-
30 files changed, 63 insertions(+), 63 deletions(-)
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 6187ce2..39b9395 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -604,7 +604,7 @@ TclpRealloc(
if (maxSize < numBytes) {
numBytes = maxSize;
}
- memcpy(newPtr, oldPtr, (size_t) numBytes);
+ memcpy(newPtr, oldPtr, numBytes);
TclpFree(oldPtr);
return newPtr;
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 50bc84e..2ac6fef 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4139,7 +4139,7 @@ Tcl_CancelEval(
if (resultObjPtr != NULL) {
result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
- memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
+ memcpy(cancelInfo->result, result, cancelInfo->length);
TclDecrRefCount(resultObjPtr); /* Discard their result object. */
} else {
cancelInfo->result = NULL;
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 8f4f6ab..f66aff7 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -339,7 +339,7 @@ Tcl_SetByteArrayObj(
byteArrayPtr->allocated = length;
if ((bytes != NULL) && (length > 0)) {
- memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
+ memcpy(byteArrayPtr->bytes, bytes, length);
}
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
@@ -532,7 +532,7 @@ DupByteArrayInternalRep(
copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
- memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
+ memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
SET_BYTEARRAY(copyPtr, copyArrayPtr);
copyPtr->typePtr = &tclByteArrayType;
@@ -593,7 +593,7 @@ UpdateStringOfByteArray(
objPtr->length = size;
if (size == length) {
- memcpy(dst, src, (size_t) size);
+ memcpy(dst, src, size);
dst[size] = '\0';
} else {
for (i = 0; i < length; i++) {
@@ -945,7 +945,7 @@ BinaryFormatCmd(
resultPtr = Tcl_NewObj();
buffer = Tcl_SetByteArrayLength(resultPtr, length);
- memset(buffer, 0, (size_t) length);
+ memset(buffer, 0, length);
/*
* Pack the data into the result object. Note that we can skip the error
@@ -982,10 +982,10 @@ BinaryFormatCmd(
count = 1;
}
if (length >= count) {
- memcpy(cursor, bytes, (size_t) count);
+ memcpy(cursor, bytes, count);
} else {
- memcpy(cursor, bytes, (size_t) length);
- memset(cursor + length, pad, (size_t) (count - length));
+ memcpy(cursor, bytes, length);
+ memset(cursor + length, pad, count - length);
}
cursor += count;
break;
@@ -1174,7 +1174,7 @@ BinaryFormatCmd(
if (count == BINARY_NOCOUNT) {
count = 1;
}
- memset(cursor, 0, (size_t) count);
+ memset(cursor, 0, count);
cursor += count;
break;
case 'X':
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 9c3cbff..2730443 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -623,7 +623,7 @@ Tcl_DbCkfree(
Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
- memset(ptr, GUARD_VALUE, (size_t) memp->length);
+ memset(ptr, GUARD_VALUE, memp->length);
}
total_frees++;
@@ -693,7 +693,7 @@ Tcl_DbCkrealloc(
copySize = memp->length;
}
newPtr = Tcl_DbCkalloc(size, file, line);
- memcpy(newPtr, ptr, (size_t) copySize);
+ memcpy(newPtr, ptr, copySize);
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
@@ -727,7 +727,7 @@ Tcl_AttemptDbCkrealloc(
if (newPtr == NULL) {
return NULL;
}
- memcpy(newPtr, ptr, (size_t) copySize);
+ memcpy(newPtr, ptr, copySize);
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 298b3b7..b9b6b6c 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2288,7 +2288,7 @@ StringReptCmd(
return TCL_ERROR;
}
for (index = 0; index < count; index++) {
- memcpy(string2 + (length1 * index), string1, (size_t) length1);
+ memcpy(string2 + (length1 * index), string1, length1);
}
string2[length2] = '\0';
@@ -2850,7 +2850,7 @@ TclStringCmp(
* The comparison function should compare up to the minimum byte
* length only.
*/
- match = memCmpFn(s1, s2, (size_t) length);
+ match = memCmpFn(s1, s2, length);
}
if ((match == 0) && (reqlength > length)) {
match = s1len - s2len;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 31e2c88..ddfe0dc 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -756,7 +756,7 @@ TclCompileStringMatchCmd(
}
str = tokenPtr[1].start;
length = tokenPtr[1].size;
- if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
+ if ((length <= 1) || strncmp(str, "-nocase", length)) {
/*
* Fail at run time, not in compilation.
*/
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 9c7ab8d..0d33821 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2068,7 +2068,7 @@ ParseLexeme(
} else {
char utfBytes[TCL_UTF_MAX];
- memcpy(utfBytes, start, (size_t) numBytes);
+ memcpy(utfBytes, start, numBytes);
utfBytes[numBytes] = '\0';
scanned = TclUtfToUniChar(utfBytes, &ch);
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ece0cae..1cc655e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2820,7 +2820,7 @@ TclInitByteCodeObj(
p += sizeof(ByteCode);
codePtr->codeStart = p;
- memcpy(p, envPtr->codeStart, (size_t) codeBytes);
+ memcpy(p, envPtr->codeStart, codeBytes);
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
@@ -2853,7 +2853,7 @@ TclInitByteCodeObj(
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
if (exceptArrayBytes > 0) {
codePtr->exceptArrayPtr = (ExceptionRange *) p;
- memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
+ memcpy(p, envPtr->exceptArrayPtr, exceptArrayBytes);
} else {
codePtr->exceptArrayPtr = NULL;
}
@@ -2861,7 +2861,7 @@ TclInitByteCodeObj(
p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
if (auxDataArrayBytes > 0) {
codePtr->auxDataArrayPtr = (AuxData *) p;
- memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
+ memcpy(p, envPtr->auxDataArrayPtr, auxDataArrayBytes);
} else {
codePtr->auxDataArrayPtr = NULL;
}
@@ -3028,7 +3028,7 @@ TclFindCompiledLocal(
localPtr->resolveInfo = NULL;
if (name != NULL) {
- memcpy(localPtr->name, name, (size_t) nameBytes);
+ memcpy(localPtr->name, name, nameBytes);
}
localPtr->name[nameBytes] = '\0';
procPtr->numCompiledLocals++;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index dd82f95..aacf565 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2838,7 +2838,7 @@ TEBCresume(
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
bytes = TclGetStringFromObj(*currPtr, &length);
if (bytes != NULL) {
- memcpy(p, bytes, (size_t) length);
+ memcpy(p, bytes, length);
p += length;
}
}
@@ -2873,7 +2873,7 @@ TEBCresume(
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
if ((*currPtr)->bytes != tclEmptyStringRep) {
bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
- memcpy(p, bytes, (size_t) length);
+ memcpy(p, bytes, length);
p += length;
}
}
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index f7de10c..6cdfa7e 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -598,7 +598,7 @@ Tcl_SplitPath(
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
str = Tcl_GetStringFromObj(eltPtr, &len);
- memcpy(p, str, (size_t) len+1);
+ memcpy(p, str, len+1);
p += len+1;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index ab8d8ac..7abeb68 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4314,7 +4314,7 @@ Write(
* that we need to stick at the beginning of this buffer.
*/
- memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
+ memcpy(InsertPoint(bufPtr), safe, saved);
bufPtr->nextAdded += saved;
saved = 0;
}
@@ -4711,7 +4711,7 @@ Tcl_GetsObj(
gs.rawRead -= rawRead;
gs.bytesWrote--;
gs.charsWrote--;
- memmove(dst, dst + 1, (size_t) (dstEnd - dst));
+ memmove(dst, dst + 1, dstEnd - dst);
dstEnd--;
}
}
@@ -10475,7 +10475,7 @@ Tcl_IsChannelExisting(
}
if ((*chanName == *name) &&
- (memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
+ (memcmp(name, chanName, chanNameLen + 1) == 0)) {
return 1;
}
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 7c2c478..e67da14 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -4209,7 +4209,7 @@ TclFSNonnativePathType(
if (pathLen < len) {
continue;
}
- if (strncmp(strVol, path, (size_t) len) == 0) {
+ if (strncmp(strVol, path, len) == 0) {
type = TCL_PATH_ABSOLUTE;
if (filesystemPtrPtr != NULL) {
*filesystemPtrPtr = fsRecPtr->fsPtr;
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 95c68ee..d4cf1a1 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1813,8 +1813,8 @@ AliasNRCmd(
cmdv = &listRep->elements;
prefv = &aliasPtr->objPtr;
- memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
- memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+ memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
+ memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));
for (i=0; i<cmdc; i++) {
Tcl_IncrRefCount(cmdv[i]);
@@ -1862,8 +1862,8 @@ AliasObjCmd(
cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
}
- memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
- memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+ memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
+ memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));
Tcl_ResetResult(targetInterp);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 6eb6780..e0d7bcc 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -653,7 +653,7 @@ Tcl_ListObjAppendElement(
* Old intrep to be freed, re-use refCounts.
*/
- memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
+ memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
ckfree(listRepPtr);
}
listRepPtr = newPtr;
@@ -953,7 +953,7 @@ Tcl_ListObjReplace(
if ((numAfterLast > 0) && (shift != 0)) {
Tcl_Obj **src = elemPtrs + start;
- memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
+ memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*));
}
} else {
/*
@@ -1024,7 +1024,7 @@ Tcl_ListObjReplace(
*/
if (first > 0) {
- memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
+ memcpy(elemPtrs, oldPtrs, first * sizeof(Tcl_Obj *));
}
/*
diff --git a/generic/tclObj.c b/generic/tclObj.c
index a4df3e7..28fb3da 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2059,25 +2059,25 @@ ParseBoolean(
/*
* Checking the 'y' is redundant, but makes the code clearer.
*/
- if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "yes", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'n':
- if (strncmp(lowerCase, "no", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "no", length) == 0) {
newBool = 0;
goto goodBoolean;
}
return TCL_ERROR;
case 't':
- if (strncmp(lowerCase, "true", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "true", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'f':
- if (strncmp(lowerCase, "false", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "false", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2086,10 +2086,10 @@ ParseBoolean(
if (length < 2) {
return TCL_ERROR;
}
- if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "on", length) == 0) {
newBool = 1;
goto goodBoolean;
- } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+ } else if (strncmp(lowerCase, "off", length) == 0) {
newBool = 0;
goto goodBoolean;
}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index c5b1ef6..0f98881 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1745,7 +1745,7 @@ Tcl_FSGetTranslatedStringPath(
const char *orig = Tcl_GetStringFromObj(transPtr, &len);
char *result = ckalloc(len+1);
- memcpy(result, orig, (size_t) len+1);
+ memcpy(result, orig, len+1);
TclDecrRefCount(transPtr);
return result;
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 7807083..bab9d5e 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -465,7 +465,7 @@ mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
if (maxlen < 0) {
return MP_VAL;
}
- return mp_to_radix(a, str, (size_t)maxlen, NULL, radix);
+ return mp_to_radix(a, str, maxlen, NULL, radix);
}
void bn_reverse(unsigned char *s, int len)
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 8915792..03937de 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -88,13 +88,13 @@ Tcl_GetThreadData(
if (result == NULL) {
result = ckalloc(size);
- memset(result, 0, (size_t) size);
+ memset(result, 0, size);
TclThreadStorageKeySet(keyPtr, result);
}
#else /* TCL_THREADS */
if (*keyPtr == NULL) {
result = ckalloc(size);
- memset(result, 0, (size_t)size);
+ memset(result, 0, size);
*keyPtr = result;
RememberSyncObject(keyPtr, &keyRecord);
} else {
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 35b3fc3..ff18077 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -294,7 +294,7 @@ ThreadObjCmd(
script = Tcl_GetStringFromObj(objv[2], &len);
if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
- (0 == strncmp(script, "-joinable", (size_t) len))) {
+ (0 == strncmp(script, "-joinable", len))) {
joinable = 1;
script = "testthread wait"; /* Just enter event loop */
} else {
@@ -311,7 +311,7 @@ ThreadObjCmd(
script = Tcl_GetStringFromObj(objv[2], &len);
joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
- && (0 == strncmp(script, "-joinable", (size_t) len)));
+ && (0 == strncmp(script, "-joinable", len)));
script = Tcl_GetString(objv[3]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 882dc39..3178441 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1689,8 +1689,8 @@ CallTraceFunction(
* Copy the command characters into a new string.
*/
- commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1);
- memcpy(commandCopy, command, (size_t) numChars);
+ commandCopy = TclStackAlloc(interp, numChars + 1);
+ memcpy(commandCopy, command, numChars);
commandCopy[numChars] = '\0';
/*
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index e462e5e..53b01e0 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -654,7 +654,7 @@ SetOSTypeFromAny(
OSType osType;
char bytes[4] = {'\0','\0','\0','\0'};
- memcpy(bytes, Tcl_DStringValue(&ds), (size_t)Tcl_DStringLength(&ds));
+ memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
osType = (OSType) bytes[0] << 24 |
(OSType) bytes[1] << 16 |
(OSType) bytes[2] << 8 |
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index f70ce6a..35046a5 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1116,7 +1116,7 @@ TclNativeCreateNativeRep(
}
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc(len);
- memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
+ memcpy(nativePathPtr, Tcl_DStringValue(&ds), len);
Tcl_DStringFree(&ds);
return nativePathPtr;
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index b189fee..0ae0fa7 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -546,8 +546,8 @@ TclpInitLibraryPath(
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = (char *)ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
+ *valuePtr = (char *)ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, str, *lengthPtr + 1);
Tcl_DecrRefCount(pathPtr);
}
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index ddba078..1a54914 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -277,7 +277,7 @@ InitializeHostName(
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
*lengthPtr = strlen(native);
*valuePtr = ckalloc(*lengthPtr + 1);
- memcpy(*valuePtr, native, (size_t)(*lengthPtr) + 1);
+ memcpy(*valuePtr, native, *lengthPtr + 1);
}
/*
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 1293ebe..a223a1f 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -672,11 +672,11 @@ ConsoleInputProc(
*/
if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
- memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
+ memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
bytesRead = bufSize;
infoPtr->offset += bufSize;
} else {
- memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
+ memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
bytesRead = infoPtr->bytesRead - infoPtr->offset;
/*
@@ -783,7 +783,7 @@ ConsoleOutputProc(
infoPtr->writeBufLen = toWrite;
infoPtr->writeBuf = ckalloc(toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(threadInfo->readyEvent);
TclPipeThreadSignal(&threadInfo->TI);
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 357f0a1..a7a98a4 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -337,7 +337,7 @@ DoRenameFile(
* character is either end-of-string or a directory separator
*/
- if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
+ if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0)
&& (dst[Tcl_DStringLength(&srcString)] == '\\'
|| dst[Tcl_DStringLength(&srcString)] == '/'
|| dst[Tcl_DStringLength(&srcString)] == '\0')) {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index b1dd0f3..b0e08d0 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -229,8 +229,8 @@ TclpInitLibraryPath(
*encodingPtr = NULL;
bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = (char *)ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
+ *valuePtr = (char *)ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, bytes, *lengthPtr + 1);
Tcl_DecrRefCount(pathPtr);
}
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 04c371e..098ead4 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -2317,7 +2317,7 @@ PipeOutputProc(
infoPtr->writeBufLen = toWrite;
infoPtr->writeBuf = ckalloc(toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->writable);
TclPipeThreadSignal(&infoPtr->writeTI);
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index aeebb56..9023928 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1038,7 +1038,7 @@ SerialOutputProc(
infoPtr->writeBufLen = toWrite;
infoPtr->writeBuf = ckalloc(toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->evWritable);
TclPipeThreadSignal(&infoPtr->writeTI);
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index fdb7e12..a05b8f6 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -378,7 +378,7 @@ InitializeHostName(
*encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
*lengthPtr = Tcl_DStringLength(&ds);
*valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
+ memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
Tcl_DStringFree(&ds);
}
--
cgit v0.12
From 30710a3cbde4192fff4a2f255c2fff0491dec7ac Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 11 Aug 2020 12:44:21 +0000
Subject: Code cleanup: less of use "register" keyword, and better use of
typecasts
---
compat/mkstemp.c | 2 +-
macosx/tclMacOSXFCmd.c | 2 +-
unix/tclLoadAix.c | 24 ++++++++++++------------
unix/tclUnixCompat.c | 40 +++++++++++++++++++++-------------------
unix/tclUnixInit.c | 39 ++++++++++++++++++++++++---------------
unix/tclUnixThrd.c | 37 +++++++++++++++++++------------------
6 files changed, 78 insertions(+), 66 deletions(-)
diff --git a/compat/mkstemp.c b/compat/mkstemp.c
index 1a44dfa..6807414 100644
--- a/compat/mkstemp.c
+++ b/compat/mkstemp.c
@@ -36,7 +36,7 @@ mkstemp(
{
static const char alphanumerics[] =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
- register char *a, *b;
+ char *a, *b;
int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */
a = template + strlen(template);
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index 53b01e0..6275aac 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -689,7 +689,7 @@ SetOSTypeFromAny(
static void
UpdateStringOfOSType(
- register Tcl_Obj *objPtr) /* OSType object whose string rep to
+ Tcl_Obj *objPtr) /* OSType object whose string rep to
* update. */
{
char string[5];
diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c
index 88e6b50..fea9494 100644
--- a/unix/tclLoadAix.c
+++ b/unix/tclLoadAix.c
@@ -98,7 +98,7 @@ dlopen(
const char *path,
int mode)
{
- register ModulePtr mp;
+ ModulePtr mp;
static void *mainModule;
/*
@@ -134,7 +134,7 @@ dlopen(
return NULL;
}
- mp->name = malloc((unsigned) (strlen(path) + 1));
+ mp->name = malloc(strlen(path) + 1);
strcpy(mp->name, path);
/*
@@ -191,7 +191,7 @@ dlopen(
*/
if (mode & RTLD_GLOBAL) {
- register ModulePtr mp1;
+ ModulePtr mp1;
for (mp1 = mp->next; mp1; mp1 = mp1->next) {
if (loadbind(0, mp1->entry, mp->entry) == -1) {
@@ -243,7 +243,7 @@ static void
caterr(
char *s)
{
- register char *p = s;
+ char *p = s;
while (*p >= '0' && *p <= '9') {
p++;
@@ -282,9 +282,9 @@ dlsym(
void *handle,
const char *symbol)
{
- register ModulePtr mp = (ModulePtr)handle;
- register ExportPtr ep;
- register int i;
+ ModulePtr mp = (ModulePtr)handle;
+ ExportPtr ep;
+ int i;
/*
* Could speed up the search, but I assume that one assigns the result to
@@ -317,9 +317,9 @@ int
dlclose(
void *handle)
{
- register ModulePtr mp = (ModulePtr)handle;
+ ModulePtr mp = (ModulePtr)handle;
int result;
- register ModulePtr mp1;
+ ModulePtr mp1;
if (--mp->refCnt > 0) {
return 0;
@@ -343,8 +343,8 @@ dlclose(
}
if (mp->exports) {
- register ExportPtr ep;
- register int i;
+ ExportPtr ep;
+ int i;
for (ep = mp->exports, i = mp->nExports; i; i--, ep++) {
if (ep->name) {
free(ep->name);
@@ -541,7 +541,7 @@ readExports(
tmpsym[SYMNMLEN] = '\0';
symname = tmpsym;
}
- ep->name = malloc((unsigned) (strlen(symname) + 1));
+ ep->name = malloc(strlen(symname) + 1);
strcpy(ep->name, symname);
ep->addr = (void *)((unsigned long)
mp->entry + ls->l_value - shdata.s_vaddr);
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 2a68f7f..4f7af3e 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -49,7 +49,7 @@
#ifdef TCL_THREADS
-typedef struct ThreadSpecificData {
+typedef struct {
struct passwd pwd;
#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
#define NEED_PW_CLEANER 1
@@ -118,10 +118,10 @@ static int CopyString(const char *src, char *buf, int buflen);
#endif
#ifdef NEED_PW_CLEANER
-static void FreePwBuf(ClientData ignored);
+static void FreePwBuf(ClientData dummy);
#endif
#ifdef NEED_GR_CLEANER
-static void FreeGrBuf(ClientData ignored);
+static void FreeGrBuf(ClientData dummy);
#endif
#endif /* TCL_THREADS */
@@ -201,7 +201,7 @@ TclpGetPwNam(
if (tsdPtr->pbuflen < 1) {
tsdPtr->pbuflen = 1024;
}
- tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen);
Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
}
while (1) {
@@ -214,7 +214,7 @@ TclpGetPwNam(
return NULL;
}
tsdPtr->pbuflen *= 2;
- tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
}
return (pwPtr != NULL ? &tsdPtr->pwd : NULL);
@@ -281,7 +281,7 @@ TclpGetPwUid(
if (tsdPtr->pbuflen < 1) {
tsdPtr->pbuflen = 1024;
}
- tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen);
Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
}
while (1) {
@@ -294,7 +294,7 @@ TclpGetPwUid(
return NULL;
}
tsdPtr->pbuflen *= 2;
- tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
}
return (pwPtr != NULL ? &tsdPtr->pwd : NULL);
@@ -336,9 +336,10 @@ TclpGetPwUid(
#ifdef NEED_PW_CLEANER
static void
FreePwBuf(
- ClientData ignored)
+ ClientData dummy)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ (void)dummy;
ckfree(tsdPtr->pbuf);
}
@@ -384,7 +385,7 @@ TclpGetGrNam(
if (tsdPtr->gbuflen < 1) {
tsdPtr->gbuflen = 1024;
}
- tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
+ tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen);
Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
}
while (1) {
@@ -397,7 +398,7 @@ TclpGetGrNam(
return NULL;
}
tsdPtr->gbuflen *= 2;
- tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
+ tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
}
return (grPtr != NULL ? &tsdPtr->grp : NULL);
@@ -464,7 +465,7 @@ TclpGetGrGid(
if (tsdPtr->gbuflen < 1) {
tsdPtr->gbuflen = 1024;
}
- tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
+ tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen);
Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
}
while (1) {
@@ -477,7 +478,7 @@ TclpGetGrGid(
return NULL;
}
tsdPtr->gbuflen *= 2;
- tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
+ tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
}
return (grPtr != NULL ? &tsdPtr->grp : NULL);
@@ -519,9 +520,10 @@ TclpGetGrGid(
#ifdef NEED_GR_CLEANER
static void
FreeGrBuf(
- ClientData ignored)
+ ClientData dummy)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ (void)dummy;
ckfree(tsdPtr->gbuf);
}
@@ -685,8 +687,8 @@ CopyGrp(
char *buf,
int buflen)
{
- register char *p = buf;
- register int copied, len = 0;
+ char *p = buf;
+ int copied, len = 0;
/*
* Copy username.
@@ -887,7 +889,7 @@ CopyArray(
int buflen) /* Size of buffer. */
{
int i, j, len = 0;
- char *p, **new;
+ char *p, **newBuffer;
if (src == NULL) {
return 0;
@@ -903,7 +905,7 @@ CopyArray(
return -1;
}
- new = (char **) buf;
+ newBuffer = (char **)buf;
p = buf + len;
for (j = 0; j < i; j++) {
@@ -914,10 +916,10 @@ CopyArray(
return -1;
}
memcpy(p, src[j], sz);
- new[j] = p;
+ newBuffer[j] = p;
p = buf + len;
}
- new[j] = NULL;
+ newBuffer[j] = NULL;
return len;
}
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 0ae0fa7..d0f8521 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -33,11 +33,20 @@
#endif
#ifdef __CYGWIN__
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __clang__
+#pragma clang diagnostic ignored "-Wignored-attributes"
+#endif
DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *);
DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *);
DLLIMPORT extern __stdcall void FreeLibrary(void *);
DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *);
DLLIMPORT extern __stdcall void GetSystemInfo(void *);
+#ifdef __cplusplus
+}
+#endif
#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
@@ -110,7 +119,7 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
* first list checked for a mapping from env encoding to Tcl encoding name.
*/
-typedef struct LocaleTable {
+typedef struct {
const char *lang;
const char *encoding;
} LocaleTable;
@@ -764,7 +773,7 @@ InitMacLocaleInfoVar(
if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
Tcl_ResetResult(interp);
}
- Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
}
CFRelease(localeRef);
}
@@ -800,9 +809,9 @@ TclpSetVariables(
const char *str;
CFBundleRef bundleRef;
- Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
@@ -818,9 +827,9 @@ TclpSetVariables(
*p = ' ';
}
} while (*p++);
- Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_DStringFree(&ds);
}
@@ -835,9 +844,9 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
@@ -848,20 +857,20 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
}
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
} else
#endif /* HAVE_COREFOUNDATION */
{
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY);
}
#ifdef DJGPP
@@ -874,7 +883,7 @@ TclpSetVariables(
#ifdef __CYGWIN__
unameOK = 1;
if (!osInfoInitialized) {
- HANDLE handle = GetModuleHandleW(L"NTDLL");
+ void *handle = GetModuleHandleW(L"NTDLL");
int(__stdcall *getversion)(void *) =
(int(__stdcall *)(void *))GetProcAddress(handle, "RtlGetVersion");
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
@@ -1009,7 +1018,7 @@ TclpFindVariable(
* searches). */
{
int i, result = -1;
- register const char *env, *p1, *p2;
+ const char *env, *p1, *p2;
Tcl_DString envString;
Tcl_DStringInit(&envString);
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 68852a1..afb795d 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -89,7 +89,7 @@ TclpThreadCreate(
#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
if (stackSize != TCL_THREAD_STACK_DEFAULT) {
- pthread_attr_setstacksize(&attr, (size_t) stackSize);
+ pthread_attr_setstacksize(&attr, stackSize);
#ifdef TCL_THREAD_STACK_MIN
} else {
/*
@@ -114,8 +114,8 @@ TclpThreadCreate(
}
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */
- if (! (flags & TCL_THREAD_JOINABLE)) {
- pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
+ if (!(flags & TCL_THREAD_JOINABLE)) {
+ pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
}
if (pthread_create(&theThread, &attr,
@@ -252,7 +252,7 @@ TclpInitLock(void)
/*
*----------------------------------------------------------------------
*
- * TclpFinalizeLock
+ * TclFinalizeLock
*
* This procedure is used to destroy all private resources used in this
* file.
@@ -334,7 +334,6 @@ TclpGlobalLock(void)
pthread_mutex_lock(&globalLock);
#endif
}
-
/*
*----------------------------------------------------------------------
@@ -427,7 +426,7 @@ Tcl_MutexLock(
* Double inside global lock check to avoid a race condition.
*/
- pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
+ pmutexPtr = (pthread_mutex_t *)ckalloc(sizeof(pthread_mutex_t));
pthread_mutex_init(pmutexPtr, NULL);
*mutexPtr = (Tcl_Mutex)pmutexPtr;
TclRememberMutex(mutexPtr);
@@ -537,7 +536,7 @@ Tcl_ConditionWait(
*/
if (*condPtr == NULL) {
- pcondPtr = ckalloc(sizeof(pthread_cond_t));
+ pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t));
pthread_cond_init(pcondPtr, NULL);
*condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
@@ -588,11 +587,12 @@ Tcl_ConditionNotify(
Tcl_Condition *condPtr)
{
pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);
+
if (pcondPtr != NULL) {
pthread_cond_broadcast(pcondPtr);
} else {
/*
- * Noone has used the condition variable, so there are no waiters.
+ * No-one has used the condition variable, so there are no waiters.
*/
}
}
@@ -683,18 +683,18 @@ TclpInetNtoa(
static volatile int initialized = 0;
static pthread_key_t key;
-typedef struct allocMutex {
+typedef struct {
Tcl_Mutex tlock;
pthread_mutex_t plock;
-} allocMutex;
+} AllocMutex;
Tcl_Mutex *
TclpNewAllocMutex(void)
{
- struct allocMutex *lockPtr;
- register pthread_mutex_t *plockPtr;
+ AllocMutex *lockPtr;
+ pthread_mutex_t *plockPtr;
- lockPtr = malloc(sizeof(struct allocMutex));
+ lockPtr = (AllocMutex *)malloc(sizeof(AllocMutex));
if (lockPtr == NULL) {
Tcl_Panic("could not allocate lock");
}
@@ -708,7 +708,8 @@ void
TclpFreeAllocMutex(
Tcl_Mutex *mutex) /* The alloc mutex to free. */
{
- allocMutex* lockPtr = (allocMutex*) mutex;
+ AllocMutex *lockPtr = (AllocMutex *)mutex;
+
if (!lockPtr) {
return;
}
@@ -767,7 +768,7 @@ TclpThreadCreateKey(void)
{
pthread_key_t *ptkeyPtr;
- ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr, 0);
+ ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0);
if (NULL == ptkeyPtr) {
Tcl_Panic("unable to allocate thread key!");
}
@@ -783,7 +784,7 @@ void
TclpThreadDeleteKey(
void *keyPtr)
{
- pthread_key_t *ptkeyPtr = keyPtr;
+ pthread_key_t *ptkeyPtr = (pthread_key_t *)keyPtr;
if (pthread_key_delete(*ptkeyPtr)) {
Tcl_Panic("unable to delete key!");
@@ -797,7 +798,7 @@ TclpThreadSetGlobalTSD(
void *tsdKeyPtr,
void *ptr)
{
- pthread_key_t *ptkeyPtr = tsdKeyPtr;
+ pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;
if (pthread_setspecific(*ptkeyPtr, ptr)) {
Tcl_Panic("unable to set global TSD value");
@@ -808,7 +809,7 @@ void *
TclpThreadGetGlobalTSD(
void *tsdKeyPtr)
{
- pthread_key_t *ptkeyPtr = tsdKeyPtr;
+ pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;
return pthread_getspecific(*ptkeyPtr);
}
--
cgit v0.12
From c07c2bb91ccfa02ec939148c02317d2e2978a4c2 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 11 Aug 2020 13:15:37 +0000
Subject: Revert unintended ckalloc -> Tcl_Alloc change from previous commit
---
unix/tclUnixCompat.c | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 4f7af3e..451a409 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -201,7 +201,7 @@ TclpGetPwNam(
if (tsdPtr->pbuflen < 1) {
tsdPtr->pbuflen = 1024;
}
- tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen);
Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
}
while (1) {
@@ -214,7 +214,7 @@ TclpGetPwNam(
return NULL;
}
tsdPtr->pbuflen *= 2;
- tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
}
return (pwPtr != NULL ? &tsdPtr->pwd : NULL);
@@ -281,7 +281,7 @@ TclpGetPwUid(
if (tsdPtr->pbuflen < 1) {
tsdPtr->pbuflen = 1024;
}
- tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen);
Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
}
while (1) {
@@ -294,7 +294,7 @@ TclpGetPwUid(
return NULL;
}
tsdPtr->pbuflen *= 2;
- tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
+ tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
}
return (pwPtr != NULL ? &tsdPtr->pwd : NULL);
--
cgit v0.12