summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-08-31 09:23:59 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-08-31 09:23:59 (GMT)
commit30fd8c842c97d0977b8ef7a4f4ee8528d260f6f2 (patch)
tree162ffad549156a8b60835cf468b7a52159e5aa1a
parent213447740b2103263aec6b22da904e038cb915e9 (diff)
parent749efa7f8436be1e60c3424b86fff5e76a01f8ec (diff)
downloadtcl-30fd8c842c97d0977b8ef7a4f4ee8528d260f6f2.zip
tcl-30fd8c842c97d0977b8ef7a4f4ee8528d260f6f2.tar.gz
tcl-30fd8c842c97d0977b8ef7a4f4ee8528d260f6f2.tar.bz2
Implement TIP #581: Master/Slave
-rw-r--r--doc/CrtAlias.329
-rw-r--r--doc/interp.n6
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCmdIL.c2
-rw-r--r--generic/tclCompile.c2
-rw-r--r--generic/tclDecls.h3
-rw-r--r--generic/tclIntDecls.h2
-rw-r--r--generic/tclInterp.c25
-rw-r--r--generic/tclLoad.c6
-rw-r--r--generic/tclTest.c6
-rw-r--r--tests/interp.test8
11 files changed, 65 insertions, 26 deletions
diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index 10192e9..a0041af 100644
--- a/doc/CrtAlias.3
+++ b/doc/CrtAlias.3
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
+Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_CreateSlave, Tcl_GetChild, Tcl_GetSlave, Tcl_GetParent, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -19,12 +19,27 @@ int
int
\fBTcl_MakeSafe\fR(\fIinterp\fR)
.sp
+.VS "TIP 581"
+Tcl_Interp *
+\fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR)
+.VE "TIP 581"
+.sp
Tcl_Interp *
\fBTcl_CreateSlave\fR(\fIinterp, name, isSafe\fR)
.sp
+.VS "TIP 581"
+Tcl_Interp *
+\fBTcl_GetChild\fR(\fIinterp, name\fR)
+.VE "TIP 581"
+.sp
Tcl_Interp *
\fBTcl_GetSlave\fR(\fIinterp, name\fR)
.sp
+.VS "TIP 581"
+Tcl_Interp *
+\fBTcl_GetParent\fR(\fIinterp\fR)
+.VE "TIP 581"
+.sp
Tcl_Interp *
\fBTcl_GetMaster\fR(\fIinterp\fR)
.sp
@@ -133,6 +148,10 @@ slave in which Tcl code has access only to set of Tcl commands defined as
see the manual entry for the Tcl \fBinterp\fR command for details.
If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
.PP
+.VS "TIP 581"
+\fBTcl_CreateChild\fR is a synonym for \fBTcl_CreateSlave\fR.
+.VE "TIP 581"
+.PP
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
.QW safe
(was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
@@ -154,10 +173,18 @@ may be a better choice, since it creates interpreters in a known-safe state.
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
.PP
+.VS "TIP 581"
+\fBTcl_GetChild\fR is a synonym for \fBTcl_GetSlave\fR.
+.VE "TIP 581"
+.PP
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
+.VS "TIP 581"
+\fBTcl_GetParent\fR is a synonym for \fBTcl_GetMaster\fR.
+.VE "TIP 581"
+.PP
\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
the relative path between \fIinterp\fR and \fIslaveInterp\fR;
\fIslaveInterp\fR must be a slave of \fIinterp\fR. If the computation
diff --git a/doc/interp.n b/doc/interp.n
index 9fcd055..9f975d0 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -377,6 +377,12 @@ Returns a Tcl list of the names of all the slave interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.TP
+.VS "TIP 581"
+\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
+.
+Synonym for . \fBinterp\fR \fBslaves\fR ?\fIpath\fR?
+.VE "TIP 581"
+.TP
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
.
Returns a Tcl list describing the target interpreter for an alias. The
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2ac6fef..124702c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3448,7 +3448,7 @@ CancelEvalProc(
* interpreters belonging to this one.
*/
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
+ TclSetChildCancelFlags((Tcl_Interp *) iPtr,
cancelInfo->flags | CANCELED, 0);
/*
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index e97d495..8ecd145 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1054,7 +1054,7 @@ InfoErrorStackCmd(
target = interp;
if (objc == 2) {
- target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
+ target = Tcl_GetChild(interp, Tcl_GetString(objv[1]));
if (target == NULL) {
return TCL_ERROR;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1cc655e..b79d504 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -827,7 +827,7 @@ TclSetByteCodeFromAny(
* faster code in some cases, and more compact code in more.
*/
- if (Tcl_GetMaster(interp) == NULL &&
+ if (Tcl_GetParent(interp) == NULL &&
!Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
&& IsCompactibleCompileEnv(interp, &compEnv)) {
TclFreeCompileEnv(&compEnv);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index e341731..e0854d6 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3974,5 +3974,8 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp,objPtr) \
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+#define Tcl_CreateChild Tcl_CreateSlave
+#define Tcl_GetChild Tcl_GetSlave
+#define Tcl_GetParent Tcl_GetMaster
#endif /* _TCLDECLS */
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 7560d11..ffe0e17 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -1422,4 +1422,6 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TclCopyChannelOld
#undef TclSockMinimumBuffersOld
+#define TclSetChildCancelFlags TclSetSlaveCancelFlags
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index d4cf1a1..a222cae 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -611,7 +611,7 @@ NRInterpCmd(
int index;
static const char *const options[] = {
"alias", "aliases", "bgerror", "cancel",
- "create", "debug", "delete",
+ "children", "create", "debug", "delete",
"eval", "exists", "expose",
"hide", "hidden", "issafe",
"invokehidden", "limit", "marktrusted", "recursionlimit",
@@ -620,7 +620,7 @@ NRInterpCmd(
};
enum option {
OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
- OPT_CREATE, OPT_DEBUG, OPT_DELETE,
+ OPT_CHILDREN, OPT_CREATE, OPT_DEBUG, OPT_DELETE,
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
OPT_INVOKEHID, OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT,
@@ -1008,6 +1008,7 @@ NRInterpCmd(
return TCL_ERROR;
}
return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
+ case OPT_CHILDREN:
case OPT_SLAVES: {
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
@@ -1981,7 +1982,7 @@ AliasObjCmdDeleteProc(
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateSlave --
+ * Tcl_CreateChild --
*
* Creates a slave interpreter. The slavePath argument denotes the name
* of the new slave relative to the current interpreter; the slave is a
@@ -2002,7 +2003,7 @@ AliasObjCmdDeleteProc(
*/
Tcl_Interp *
-Tcl_CreateSlave(
+Tcl_CreateChild(
Tcl_Interp *interp, /* Interpreter to start search at. */
const char *slavePath, /* Name of slave to create. */
int isSafe) /* Should new slave be "safe" ? */
@@ -2020,7 +2021,7 @@ Tcl_CreateSlave(
/*
*----------------------------------------------------------------------
*
- * Tcl_GetSlave --
+ * Tcl_GetChild --
*
* Finds a slave interpreter by its path name.
*
@@ -2034,7 +2035,7 @@ Tcl_CreateSlave(
*/
Tcl_Interp *
-Tcl_GetSlave(
+Tcl_GetChild(
Tcl_Interp *interp, /* Interpreter to start search from. */
const char *slavePath) /* Path of slave to find. */
{
@@ -2051,7 +2052,7 @@ Tcl_GetSlave(
/*
*----------------------------------------------------------------------
*
- * Tcl_GetMaster --
+ * Tcl_GetParent --
*
* Finds the master interpreter of a slave interpreter.
*
@@ -2065,7 +2066,7 @@ Tcl_GetSlave(
*/
Tcl_Interp *
-Tcl_GetMaster(
+Tcl_GetParent(
Tcl_Interp *interp) /* Get the master of this interpreter. */
{
Slave *slavePtr; /* Slave record of this interpreter. */
@@ -2080,7 +2081,7 @@ Tcl_GetMaster(
/*
*----------------------------------------------------------------------
*
- * TclSetSlaveCancelFlags --
+ * TclSetChildCancelFlags --
*
* This function marks all slave interpreters belonging to a given
* interpreter as being canceled or not canceled, depending on the
@@ -2096,7 +2097,7 @@ Tcl_GetMaster(
*/
void
-TclSetSlaveCancelFlags(
+TclSetChildCancelFlags(
Tcl_Interp *interp, /* Set cancel flags of this interpreter. */
int flags, /* Collection of OR-ed bits that control
* the cancellation of the script. Only
@@ -2139,7 +2140,7 @@ TclSetSlaveCancelFlags(
* interpreter.
*/
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force);
+ TclSetChildCancelFlags((Tcl_Interp *) iPtr, flags, force);
}
}
@@ -2793,7 +2794,7 @@ SlaveEval(
* function for that particular Tcl_Interp.
*/
- TclSetSlaveCancelFlags(slaveInterp, 0, 0);
+ TclSetChildCancelFlags(slaveInterp, 0, 0);
Tcl_Preserve(slaveInterp);
Tcl_AllowExceptions(slaveInterp);
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index dfa657e..062f007 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -198,7 +198,7 @@ Tcl_LoadObjCmd(
if (objc == 4) {
const char *slaveIntName = Tcl_GetString(objv[3]);
- target = Tcl_GetSlave(interp, slaveIntName);
+ target = Tcl_GetChild(interp, slaveIntName);
if (target == NULL) {
code = TCL_ERROR;
goto done;
@@ -621,7 +621,7 @@ Tcl_UnloadObjCmd(
if (objc - i == 3) {
const char *slaveIntName = Tcl_GetString(objv[i + 2]);
- target = Tcl_GetSlave(interp, slaveIntName);
+ target = Tcl_GetChild(interp, slaveIntName);
if (target == NULL) {
return TCL_ERROR;
}
@@ -1068,7 +1068,7 @@ TclGetLoadedPackages(
* interpreter.
*/
- target = Tcl_GetSlave(interp, targetName);
+ target = Tcl_GetChild(interp, targetName);
if (target == NULL) {
return TCL_ERROR;
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index fde7190..7624004 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1515,7 +1515,7 @@ TestdelCmd(
return TCL_ERROR;
}
- slave = Tcl_GetSlave(interp, argv[1]);
+ slave = Tcl_GetChild(interp, argv[1]);
if (slave == NULL) {
return TCL_ERROR;
}
@@ -2698,7 +2698,7 @@ TestinterpdeleteCmd(
" path\"", NULL);
return TCL_ERROR;
}
- slaveToDelete = Tcl_GetSlave(interp, argv[1]);
+ slaveToDelete = Tcl_GetChild(interp, argv[1]);
if (slaveToDelete == NULL) {
return TCL_ERROR;
}
@@ -7781,7 +7781,7 @@ TestInterpResolverCmd(
return TCL_ERROR;
}
if (objc == 3) {
- interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
+ interp = Tcl_GetChild(interp, Tcl_GetString(objv[2]));
if (interp == NULL) {
Tcl_AppendResult(interp, "provided interpreter not found", NULL);
return TCL_ERROR;
diff --git a/tests/interp.test b/tests/interp.test
index 5b7b157..df94678 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -32,7 +32,7 @@ test interp-1.1 {options for interp command} -returnCodes error -body {
} -result {wrong # args: should be "interp cmd ?arg ...?"}
test interp-1.2 {options for interp command} -returnCodes error -body {
interp frobox
-} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -50,13 +50,13 @@ test interp-1.6 {options for interp command} -returnCodes error -body {
} -result {wrong # args: should be "interp slaves ?path?"}
test interp-1.7 {options for interp command} -returnCodes error -body {
interp hello
-} -result {bad option "hello": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
interp -froboz
-} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
interp -froboz -safe
-} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.10 {options for interp command} -returnCodes error -body {
interp target
} -result {wrong # args: should be "interp target path alias"}