Compare commits

...
62 changed files with 1706 additions and 1734 deletions
+33 -54
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
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
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, 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,47 +19,38 @@ 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)
\fBTcl_GetChild\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)
\fBTcl_GetParent\fR(\fIinterp\fR)
.sp
int
\fBTcl_GetInterpPath\fR(\fIinterp, slaveInterp\fR)
\fBTcl_GetInterpPath\fR(\fIinterp, childInterp\fR)
.sp
int
\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
\fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
argc, argv\fR)
.sp
int
\fBTcl_CreateAliasObj\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
\fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
objc, objv\fR)
.sp
int
\fBTcl_GetAlias\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
argcPtr, argvPtr\fR)
.sp
int
\fBTcl_GetAliasObj\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
\fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
objcPtr, objvPtr\fR)
.sp
int
@@ -72,16 +63,16 @@ int
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *name in
Name of slave interpreter to create or manipulate.
Name of child interpreter to create or manipulate.
.AP int isSafe in
If non-zero, a
.QW safe
slave that is suitable for running untrusted code
is created, otherwise a trusted slave is created.
.AP Tcl_Interp *slaveInterp in
child that is suitable for running untrusted code
is created, otherwise a trusted child is created.
.AP Tcl_Interp *childInterp in
Interpreter to use for creating the source command for an alias (see
below).
.AP "const char" *slaveCmd in
.AP "const char" *childCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
@@ -136,21 +127,17 @@ interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the interpreter's result contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
\fBTcl_CreateChild\fR creates a new interpreter as a child of \fIinterp\fR.
It also creates a child command named \fIname\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new child.
If \fIisSafe\fR is zero, the command creates a trusted child in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
.QW safe
slave in which Tcl code has access only to set of Tcl commands defined as
child in which Tcl code has access only to set of Tcl commands defined as
.QW "Safe Tcl" ;
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"
If the creation of the new child interpreter failed, \fBNULL\fR is returned.
.PP
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
.QW safe
@@ -166,42 +153,34 @@ from \fIinterp\fR. However, it cannot know what parts of an extension
or application are safe and does not make any attempt to remove those
parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR.
Callers will want to take care with their use of \fBTcl_MakeSafe\fR
to avoid false claims of safety. For many situations, \fBTcl_CreateSlave\fR
to avoid false claims of safety. For many situations, \fBTcl_CreateChild\fR
may be a better choice, since it creates interpreters in a known-safe state.
.PP
\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
\fBTcl_GetChild\fR returns a pointer to a child interpreter of
\fIinterp\fR. The child interpreter is identified by \fIname\fR.
If no such child 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
\fBTcl_GetParent\fR returns a pointer to the parent interpreter of
\fIinterp\fR. If \fIinterp\fR has no parent (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
the relative path between \fIinterp\fR and \fIchildInterp\fR;
\fIchildInterp\fR must be a child of \fIinterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
result of \fIinterp\fR.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
\fBTcl_CreateAlias\fR creates a command named \fIchildCmd\fR in
\fIchildInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
invocation of \fIchildCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
it fails; in that case, an error message is left in the value result
of \fIslaveInterp\fR.
of \fIchildInterp\fR.
Note that there are no restrictions on the ancestry relationship (as
created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
created by \fBTcl_CreateChild\fR) between \fIchildInterp\fR and
\fItargetInterp\fR. Any two interpreters can be used, without any
restrictions on how they are related.
.PP
@@ -260,4 +239,4 @@ interp
.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
master, slave
parent, child
+2 -2
View File
@@ -1350,11 +1350,11 @@ is considered to be owned by the filesystem (not by Tcl's core), but
should be given a reference count for Tcl. Tcl will use the contents of the
list and then decrement that reference count. This allows filesystems to
choose whether they actually want to retain a
.QW "master list"
.QW "main list"
of volumes
or not (if not, they generate the list on the fly and pass it to Tcl
with a reference count of 1 and then forget about the list, if yes, then
they simply increment the reference count of their master list and pass it
they simply increment the reference count of their main list and pass it
to Tcl which will copy the contents and then decrement the count back
to where it was).
.PP
+1 -1
View File
@@ -116,7 +116,7 @@ execution of the callbacks is unspecified) execution in the limited
interpreter is stopped by raising an error and setting a flag that
prevents the \fBcatch\fR command in that interpreter from trapping
that error. It is up to the context that started execution in that
interpreter (typically a master interpreter) to handle the error.
interpreter (typically a parent interpreter) to handle the error.
.SH "LIMIT CHECKING API"
.PP
To check the resource limits for an interpreter, call
+6 -6
View File
@@ -79,7 +79,7 @@ against the standard Tcl library. Extensions (stub-enabled or
not) are not intended to call \fBTcl_Main\fR.
.PP
\fBTcl_Main\fR is not thread-safe. It should only be called by
a single master thread of a multi-threaded application. This
a single main thread of a multi-threaded application. This
restriction is not a problem with normal use described above.
.PP
\fBTcl_Main\fR and therefore all applications based upon it, like
@@ -112,7 +112,7 @@ The file name and encoding values managed by the routines
\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
are stored per-thread. Although the storage and retrieval
functions of these routines work in any thread, only those
calls in the same master thread as \fBTcl_Main\fR can have
calls in the same main thread as \fBTcl_Main\fR can have
any influence on it.
.PP
The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR
@@ -126,7 +126,7 @@ a \fIstartup script\fR, and \fIname\fR is taken to be the name
of the encoding of the contents of that file. \fBTcl_Main\fR
then calls \fBTcl_SetStartupScript\fR with these values.
.PP
\fBTcl_Main\fR then defines in its master interpreter
\fBTcl_Main\fR then defines in its main interpreter
the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
.PP
@@ -154,9 +154,9 @@ When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls
been requested, if any. If a startup script has been provided,
\fBTcl_Main\fR attempts to evaluate it. Otherwise, interactive
mode begins with examination of the variable \fItcl_rcFileName\fR
in the master interpreter. If that variable exists and holds the
in the main interpreter. If that variable exists and holds the
name of a readable file, the contents of that file are evaluated
in the master interpreter. Then interactive operations begin,
in the main interpreter. Then interactive operations begin,
with prompts and command evaluation results written to the standard
output channel, and commands read from the standard input channel
and then evaluated. The prompts written to the standard output
@@ -164,7 +164,7 @@ channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
The prompts and command evaluation results are written to the standard
output channel only if the Tcl variable \fItcl_interactive\fR in the
master interpreter holds a non-zero integer value.
main interpreter holds a non-zero integer value.
.PP
\fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
This allows, for example, Tk to be dynamically loaded and set its event
+121 -127
View File
@@ -19,18 +19,18 @@ interp \- Create and manipulate Tcl interpreters
.PP
This command makes it possible to create one or more new Tcl
interpreters that co-exist with the creating interpreter in the
same application. The creating interpreter is called the \fImaster\fR
and the new interpreter is called a \fIslave\fR.
A master can create any number of slaves, and each slave can
itself create additional slaves for which it is master, resulting
same application. The creating interpreter is called the \fIparent\fR
and the new interpreter is called a \fIchild\fR.
A parent can create any number of children, and each child can
itself create additional children for which it is parent, resulting
in a hierarchy of interpreters.
.PP
Each interpreter is independent from the others: it has its own name
space for commands, procedures, and global variables.
A master interpreter may create connections between its slaves and
A parent interpreter may create connections between its children and
itself using a mechanism called an \fIalias\fR. An \fIalias\fR is
a command in a slave interpreter which, when invoked, causes a
command to be invoked in its master interpreter or in another slave
a command in a child interpreter which, when invoked, causes a
command to be invoked in its parent interpreter or in another child
interpreter. The only other connections between interpreters are
through environment variables (the \fBenv\fR variable), which are
normally shared among all interpreters in the application,
@@ -41,7 +41,7 @@ share files and to transfer references to open files from one interpreter
to another.
.PP
The \fBinterp\fR command also provides support for \fIsafe\fR
interpreters. A safe interpreter is a slave whose functions have
interpreters. A safe interpreter is a child whose functions have
been greatly restricted, so that it is safe to execute untrusted
scripts without fear of them damaging other interpreters or the
application's environment. For example, all IO channel creation
@@ -54,18 +54,18 @@ instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
kernel call) between a slave interpreter and its master.
kernel call) between a child interpreter and its parent.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl lists containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
interpreter in its immediate master. Interpreter names are relative to the
interpreter in its immediate parent. Interpreter names are relative to the
interpreter in which they are used. For example, if
.QW \fBa\fR
is a slave of the current interpreter and it has a slave
is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
which in turn has a slave
which in turn has a child
.QW \fBa11\fR ,
the qualified name of
.QW \fBa11\fR
@@ -77,14 +77,14 @@ is the list
The \fBinterp\fR command, described below, accepts qualified interpreter
names as arguments; the interpreter in which the command is being evaluated
can always be referred to as \fB{}\fR (the empty list or string). Note that
it is impossible to refer to a master (ancestor) interpreter by name in a
slave interpreter except through aliases. Also, there is no global name by
it is impossible to refer to a parent (ancestor) interpreter by name in a
child interpreter except through aliases. Also, there is no global name by
which one can refer to the first interpreter created in an application.
Both restrictions are motivated by safety concerns.
.SH "THE INTERP COMMAND"
.PP
The \fBinterp\fR command is used to create, delete, and manipulate
slave interpreters, and to share or transfer
child interpreters, and to share or transfer
channels between interpreters. It can have any of several forms, depending
on the \fIsubcommand\fR argument:
.TP
@@ -94,11 +94,11 @@ Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the name of the source command in the
slave is different from \fIsrcToken\fR).
child is different from \fIsrcToken\fR).
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR
.
Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by
Deletes the alias for \fIsrcToken\fR in the child interpreter identified by
\fIsrcPath\fR.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
@@ -106,9 +106,9 @@ command will be deleted.
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
.
This command creates an alias between one slave and another (see the
\fBalias\fR slave command below for creating aliases between a slave
and its master). In this command, either of the slave interpreters
This command creates an alias between one child and another (see the
\fBalias\fR child command below for creating aliases between a child
and its parent). In this command, either of the child interpreters
may be anywhere in the hierarchy of interpreters under the interpreter
invoking the command.
\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
@@ -117,9 +117,9 @@ interpreter. For example,
.QW "\fBa b\fR"
identifies an interpreter
.QW \fBb\fR ,
which is a slave of interpreter
which is a child of interpreter
.QW \fBa\fR ,
which is a slave of the invoking interpreter. An empty list specifies
which is a child of the invoking interpreter. An empty list specifies
the interpreter invoking the command. \fIsrcCmd\fR gives the name of
a new command, which will be created in the source interpreter.
\fITargetPath\fR and \fItargetCmd\fR specify a target interpreter
@@ -171,33 +171,33 @@ used.
.TP
\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
.
Creates a slave interpreter identified by \fIpath\fR and a new command,
called a \fIslave command\fR. The name of the slave command is the last
component of \fIpath\fR. The new slave interpreter and the slave command
Creates a child interpreter identified by \fIpath\fR and a new command,
called a \fIchild command\fR. The name of the child command is the last
component of \fIpath\fR. The new child interpreter and the child command
are created in the interpreter identified by the path obtained by removing
the last component from \fIpath\fR. For example, if \fIpath\fR is \fBa b
c\fR then a new slave interpreter and slave command named \fBc\fR are
c\fR then a new child interpreter and child command named \fBc\fR are
created in the interpreter identified by the path \fBa b\fR.
The slave command may be used to manipulate the new interpreter as
The child command may be used to manipulate the new interpreter as
described below. If \fIpath\fR is omitted, Tcl creates a unique name of the
form \fBinterp\fIx\fR, where \fIx\fR is an integer, and uses it for the
interpreter and the slave command. If the \fB\-safe\fR switch is specified
(or if the master interpreter is a safe interpreter), the new slave
interpreter and the child command. If the \fB\-safe\fR switch is specified
(or if the parent interpreter is a safe interpreter), the new child
interpreter will be created as a safe interpreter with limited
functionality; otherwise the slave will include the full set of Tcl
functionality; otherwise the child will include the full set of Tcl
built-in commands and variables. The \fB\-\|\-\fR switch can be used to
mark the end of switches; it may be needed if \fIpath\fR is an unusual
value such as \fB\-safe\fR. The result of the command is the name of the
new interpreter. The name of a slave interpreter must be unique among all
the slaves for its master; an error occurs if a slave interpreter by the
given name already exists in this master.
The initial recursion limit of the slave interpreter is set to the
new interpreter. The name of a child interpreter must be unique among all
the children for its parent; an error occurs if a child interpreter by the
given name already exists in this parent.
The initial recursion limit of the child interpreter is set to the
current recursion limit of its parent interpreter.
.TP
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
slave interpreter identified by \fIpath\fR. If no arguments are
child interpreter identified by \fIpath\fR. If no arguments are
given, option and current setting are returned. If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
@@ -239,8 +239,8 @@ consistency of the underlying interpreter's state.
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
arguments, and for each interpreter, it also deletes its children. The
command also deletes the child command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP
@@ -248,20 +248,20 @@ exists, the command raises an error.
.
This command concatenates all of the \fIarg\fR arguments in the same
fashion as the \fBconcat\fR command, then evaluates the resulting string as
a Tcl script in the slave interpreter identified by \fIpath\fR. The result
a Tcl script in the child interpreter identified by \fIpath\fR. The result
of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame of the
\fIpath\fR interpreter; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
the slave that find out information about the slave's current state
\fIpath\fR interpreter; this is so that the implementations (in a parent
interpreter) of aliases in a child interpreter can execute scripts in
the child that find out information about the child's current state
and stack frame.
.TP
\fBinterp exists \fIpath\fR
.
Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
Returns \fB1\fR if a child interpreter by the specified \fIpath\fR
exists in this parent, \fB0\fR otherwise. If \fIpath\fR is omitted, the
invoking interpreter is used.
.TP
\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
@@ -287,7 +287,7 @@ Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
@@ -371,17 +371,11 @@ Both interpreters must close it to close the underlying IO channel; IO
channels accessible in an interpreter are automatically closed when an
interpreter is destroyed.
.TP
\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
.
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"
Returns a Tcl list of the names of all the child interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.TP
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
.
@@ -399,48 +393,48 @@ The target command does not have to be defined at the time of this invocation.
Causes the IO channel identified by \fIchannelId\fR to become available in
the interpreter identified by \fIdestPath\fR and unavailable in the
interpreter identified by \fIsrcPath\fR.
.SH "SLAVE COMMAND"
.SH "CHILD COMMAND"
.PP
For each slave interpreter created with the \fBinterp\fR command, a
new Tcl command is created in the master interpreter with the same
For each child interpreter created with the \fBinterp\fR command, a
new Tcl command is created in the parent interpreter with the same
name as the new interpreter. This command may be used to invoke
various operations on the interpreter. It has the following
general form:
.PP
.CS
\fIslave command \fR?\fIarg arg ...\fR?
\fIchild command \fR?\fIarg arg ...\fR?
.CE
.PP
\fISlave\fR is the name of the interpreter, and \fIcommand\fR
\fIChild\fR is the name of the interpreter, and \fIcommand\fR
and the \fIarg\fRs determine the exact behavior of the command.
The valid forms of this command are:
.TP
\fIslave \fBaliases\fR
\fIchild \fBaliases\fR
.
Returns a Tcl list whose elements are the tokens of all the
aliases in \fIslave\fR. The tokens correspond to the values returned when
aliases in \fIchild\fR. The tokens correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fIslave \fBalias \fIsrcToken\fR
\fIchild \fBalias \fIsrcToken\fR
.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the actual source command in the
slave is different from \fIsrcToken\fR).
child is different from \fIsrcToken\fR).
.TP
\fIslave \fBalias \fIsrcToken \fB{}\fR
\fIchild \fBalias \fIsrcToken \fB{}\fR
.
Deletes the alias for \fIsrcToken\fR in the slave interpreter.
Deletes the alias for \fIsrcToken\fR in the child interpreter.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
command will be deleted.
.TP
\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
\fIchild \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
.
Creates an alias such that whenever \fIsrcCmd\fR is invoked
in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
in \fIchild\fR, \fItargetCmd\fR is invoked in the parent.
The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
arguments, prepended before any arguments passed in the invocation of
\fIsrcCmd\fR.
@@ -449,69 +443,69 @@ The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
\fIchild \fBbgerror\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
for the \fIchild\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
\fIchild \fBeval \fIarg \fR?\fIarg ..\fR?
.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
the resulting string as a Tcl script in \fIslave\fR.
the resulting string as a Tcl script in \fIchild\fR.
The result of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame
of \fIslave\fR; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
the slave that find out information about the slave's current state
of \fIchild\fR; this is so that the implementations (in a parent
interpreter) of aliases in a child interpreter can execute scripts in
the child that find out information about the child's current state
and stack frame.
.TP
\fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
\fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
.
This command exposes the hidden command \fIhiddenName\fR, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
in \fIslave\fR.
in \fIchild\fR.
If an exposed command with the targeted name already exists, this command
fails.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
\fIchild \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
.
This command hides the exposed command \fIexposedCmdName\fR, renaming it to
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
argument is not given, in the \fIslave\fR interpreter.
argument is not given, in the \fIchild\fR interpreter.
If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden are looked up in the global
namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBhidden\fR
\fIchild \fBhidden\fR
.
Returns a list of the names of all hidden commands in \fIslave\fR.
Returns a list of the names of all hidden commands in \fIchild\fR.
.TP
\fIslave \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
\fIchild \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
.
This command invokes the hidden command \fIhiddenName\fR with the
supplied arguments, in \fIslave\fR. No substitutions or evaluations are
supplied arguments, in \fIchild\fR. No substitutions or evaluations are
applied to the arguments. Three \fI\-option\fRs are supported, all
of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
If the \fB\-namespace\fR flag is given, the hidden command is invoked in
the specified namespace in the slave.
the specified namespace in the child.
If the \fB\-global\fR flag is given, the command is invoked at the global
level in the slave; otherwise it is invoked at the current call frame and
level in the child; otherwise it is invoked at the current call frame and
can access local variables in that or outer call frames.
The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
.QW \-
@@ -519,37 +513,37 @@ character, and is otherwise unnecessary.
If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the
\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
current context stack frame of \fIslave\fR.
current context stack frame of \fIchild\fR.
For more details on hidden commands,
see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBissafe\fR
\fIchild \fBissafe\fR
.
Returns \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
Returns \fB1\fR if the child interpreter is safe, \fB0\fR otherwise.
.TP
\fIslave \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
\fIchild \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
.
Sets up, manipulates and queries the configuration of the resource
limit \fIlimitType\fR for the slave interpreter. If no \fI\-option\fR
limit \fIlimitType\fR for the child interpreter. If no \fI\-option\fR
is specified, return the current configuration of the limit. If
\fI\-option\fR is the sole argument, return the value of that option.
Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must
supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of
what limits and options are supported.
.TP
\fIslave \fBmarktrusted\fR
\fIchild \fBmarktrusted\fR
.
Marks the slave interpreter as trusted. Can only be invoked by a
Marks the child interpreter as trusted. Can only be invoked by a
trusted interpreter. This command does not expose any hidden
commands in the slave interpreter. The command has no effect if the slave
commands in the child interpreter. The command has no effect if the child
is already trusted.
.TP
\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
\fIchild\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
.
Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
Returns the maximum allowable nesting depth for the \fIchild\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIchild\fR will be
set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
and related procedures in \fIslave\fR will return an error.
and related procedures in \fIchild\fR will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
maximum value of a non-long integer on the platform.
@@ -573,14 +567,14 @@ For example, commands to create files on disk are removed, and the
\fBexec\fR command is removed, since it could be used to cause damage
through subprocesses.
Limited access to these facilities can be provided, by creating
aliases to the master interpreter which check their arguments carefully
aliases to the parent interpreter which check their arguments carefully
and provide restricted access to a safe subset of facilities.
For example, file creation might be allowed in a particular subdirectory
and subprocess invocation might be allowed for a carefully selected and
fixed set of programs.
.PP
A safe interpreter is created by specifying the \fB\-safe\fR switch
to the \fBinterp create\fR command. Furthermore, any slave created
to the \fBinterp create\fR command. Furthermore, any child created
by a safe interpreter will also be safe.
.PP
A safe interpreter is created with exactly the following set of
@@ -668,14 +662,14 @@ including itself.
.PP
The alias mechanism has been carefully designed so that it can
be used safely when an untrusted script is executing
in a safe slave and the target of the alias is a trusted
master. The most important thing in guaranteeing safety is to
ensure that information passed from the slave to the master is
never evaluated or substituted in the master; if this were to
occur, it would enable an evil script in the slave to invoke
arbitrary functions in the master, which would compromise security.
in a safe child and the target of the alias is a trusted
parent. The most important thing in guaranteeing safety is to
ensure that information passed from the child to the parent is
never evaluated or substituted in the parent; if this were to
occur, it would enable an evil script in the child to invoke
arbitrary functions in the parent, which would compromise security.
.PP
When the source for an alias is invoked in the slave interpreter, the
When the source for an alias is invoked in the child interpreter, the
usual Tcl substitutions are performed when parsing that command.
These substitutions are carried out in the source interpreter just
as they would be for any other command invoked in that interpreter.
@@ -702,8 +696,8 @@ the alias's source command is parsed in the source interpreter.
When writing the \fItargetCmd\fRs for aliases in safe interpreters,
it is very important that the arguments to that command never be
evaluated or substituted, since this would provide an escape
mechanism whereby the slave interpreter could execute arbitrary
code in the master. This in turn would compromise the security
mechanism whereby the child interpreter could execute arbitrary
code in the parent. This in turn would compromise the security
of the system.
.SH "HIDDEN COMMANDS"
.PP
@@ -730,28 +724,28 @@ invoke\fR. Hidden commands and exposed commands reside in separate name
spaces. It is possible to define a hidden command and an exposed command by
the same name within one interpreter.
.PP
Hidden commands in a slave interpreter can be invoked in the body of
procedures called in the master during alias invocation. For example, an
alias for \fBsource\fR could be created in a slave interpreter. When it is
invoked in the slave interpreter, a procedure is called in the master
Hidden commands in a child interpreter can be invoked in the body of
procedures called in the parent during alias invocation. For example, an
alias for \fBsource\fR could be created in a child interpreter. When it is
invoked in the child interpreter, a procedure is called in the parent
interpreter to check that the operation is allowable (e.g. it asks to
source a file that the slave interpreter is allowed to access). The
procedure then it invokes the hidden \fBsource\fR command in the slave
source a file that the child interpreter is allowed to access). The
procedure then it invokes the hidden \fBsource\fR command in the child
interpreter to actually source in the contents of the file. Note that two
commands named \fBsource\fR exist in the slave interpreter: the alias, and
commands named \fBsource\fR exist in the child interpreter: the alias, and
the hidden command.
.PP
Because a master interpreter may invoke a hidden command as part of
Because a parent interpreter may invoke a hidden command as part of
handling an alias invocation, great care must be taken to avoid evaluating
any arguments passed in through the alias invocation.
Otherwise, malicious slave interpreters could cause a trusted master
Otherwise, malicious child interpreters could cause a trusted parent
interpreter to execute dangerous commands on their behalf. See the section
on \fBALIAS INVOCATION\fR for a more complete discussion of this topic.
To help avoid this problem, no substitutions or evaluations are
applied to arguments of \fBinterp invokehidden\fR.
.PP
Safe interpreters are not allowed to invoke hidden commands in themselves
or in their descendants. This prevents safe slaves from gaining access to
or in their descendants. This prevents safe children from gaining access to
hidden functionality in themselves or their descendants.
.PP
The set of hidden commands in an interpreter can be manipulated by a trusted
@@ -770,12 +764,12 @@ qualifiers, and you must first rename a command in a namespace to the
global namespace before you can hide it.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
.SH "RESOURCE LIMITS"
.PP
Every interpreter has two kinds of resource limits that may be imposed by any
master interpreter upon its slaves. Command limits (of type \fBcommand\fR)
parent interpreter upon its children. Command limits (of type \fBcommand\fR)
restrict the total number of Tcl commands that may be executed by an
interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and
time limits (of type \fBtime\fR) place a limit by which execution within the
@@ -784,7 +778,7 @@ interpreter must complete. Note that time limits are expressed as
\fBafter\fR) because they may be modified after creation.
.PP
When a limit is exceeded for an interpreter, first any handler callbacks
defined by master interpreters are called. If those callbacks increase or
defined by parent interpreters are called. If those callbacks increase or
remove the limit, execution within the (previously) limited interpreter
continues. If the limit is still in force, an error is generated at that point
and normal processing of errors within the interpreter (by the \fBcatch\fR
@@ -841,13 +835,13 @@ This option specifies the number of commands that the interpreter may execute
before triggering the command limit. This option may be the empty string,
which indicates that a command limit is not set for the interpreter.
.PP
Where an interpreter with a resource limit set on it creates a slave
interpreter, that slave interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating master
interpreter. If the master interpreter of the limited master wishes to relax
Where an interpreter with a resource limit set on it creates a child
interpreter, that child interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating parent
interpreter. If the parent interpreter of the limited parent wishes to relax
these conditions, it should hide the \fBinterp\fR command in the child and
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
access as it chooses to the \fBinterp\fR command to the limited master as
access as it chooses to the \fBinterp\fR command to the limited parent as
necessary.
.SH "BACKGROUND EXCEPTION HANDLING"
.PP
@@ -908,9 +902,9 @@ set i [\fBinterp create\fR]
}
.CE
.SH "SEE ALSO"
bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3), Tcl_BackgroundException(3)
bgerror(n), load(n), safe(n), Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3)
.SH KEYWORDS
alias, master interpreter, safe interpreter, slave interpreter
alias, parent interpreter, safe interpreter, child interpreter
'\"Local Variables:
'\"mode: nroff
'\"End:
+1 -1
View File
@@ -124,7 +124,7 @@ will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
generate a new index file \fBfoo/tclIndex\fR.
.PP
\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them into a
slave interpreter and monitoring the proc and namespace commands that
child interpreter and monitoring the proc and namespace commands that
are executed. Extensions can use the (undocumented)
auto_mkindex_parser package to register other commands that can
contribute to the auto_load index. You will have to read through
+2 -2
View File
@@ -42,7 +42,7 @@ The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
It does this by loading each file into a slave
It does this by loading each file into a child
interpreter and seeing what packages
and new commands appear (this is why it is essential to have
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
@@ -109,7 +109,7 @@ the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
current interpreter and match \fIpkgPat\fR into the slave interpreter used to
current interpreter and match \fIpkgPat\fR into the child interpreter used to
generate the index. The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
+50 -50
View File
@@ -11,17 +11,17 @@
.SH NAME
safe \- Creating and manipulating safe interpreters
.SH SYNOPSIS
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
.sp
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
.sp
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
.sp
\fB::safe::interpDelete\fR \fIslave\fR
\fB::safe::interpDelete\fR \fIchild\fR
.sp
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
.sp
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
.sp
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
.SS OPTIONS
@@ -44,7 +44,7 @@ application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
hosting application to any party.
.PP
Safe Tcl allows a master interpreter to create safe, restricted
Safe Tcl allows a parent interpreter to create safe, restricted
interpreters that contain a set of predefined aliases for the \fBsource\fR,
\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
are able to use the auto-loading and package mechanisms.
@@ -53,39 +53,39 @@ No knowledge of the file system structure is leaked to the
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
master interpreter transparently
parent interpreter transparently
translates the token into a real directory name and executes the
requested operation (see the section \fBSECURITY\fR below for details).
Different levels of security can be selected by using the optional flags
of the commands described below.
.PP
All commands provided in the master interpreter by Safe Tcl reside in
All commands provided in the parent interpreter by Safe Tcl reside in
the \fBsafe\fR namespace.
.SH COMMANDS
The following commands are provided in the master interpreter:
The following commands are provided in the parent interpreter:
.TP
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
Creates a safe interpreter, installs the aliases described in the section
\fBALIASES\fR and initializes the auto-loading and package mechanism as
specified by the supplied \fIoptions\fR.
See the \fBOPTIONS\fR section below for a description of the
optional arguments.
If the \fIslave\fR argument is omitted, a name will be generated.
If the \fIchild\fR argument is omitted, a name will be generated.
\fB::safe::interpCreate\fR always returns the interpreter name.
.TP
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
This command is similar to \fBinterpCreate\fR except it that does not
create the safe interpreter. \fIslave\fR must have been created by some
create the safe interpreter. \fIchild\fR must have been created by some
other means, like \fBinterp create\fR \fB\-safe\fR.
.TP
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
named safe interpreter as a list of options and their current values
for that \fIslave\fR.
for that \fIchild\fR.
If a single additional argument is provided,
it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
\fIname\fR is the full name of that option and \fIvalue\fR the current value
for that option and the \fIslave\fR.
for that option and the \fIchild\fR.
If more than two additional arguments are provided, it will reconfigure the
safe interpreter and change each and only the provided options.
See the section on \fBOPTIONS\fR below for options description.
@@ -105,14 +105,14 @@ safe::interpConfigure $i0 \-delete {foo bar} \-statics 0
.CE
.RE
.TP
\fB::safe::interpDelete\fR \fIslave\fR
\fB::safe::interpDelete\fR \fIchild\fR
Deletes the safe interpreter and cleans up the corresponding
master interpreter data structures.
parent interpreter data structures.
If a \fIdeleteHook\fR script was specified for this interpreter it is
evaluated before the interpreter is deleted, with the name of the
interpreter as an additional argument.
.TP
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
This command finds and returns the token for the real directory
\fIdirectory\fR in the safe interpreter's current virtual access path.
It generates an error if the directory is not found.
@@ -120,14 +120,14 @@ Example of use:
.RS
.PP
.CS
$slave eval [list set tk_library \e
$child eval [list set tk_library \e
[::safe::interpFindInAccessPath $name $tk_library]]
.CE
.RE
.TP
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
This command adds \fIdirectory\fR to the virtual path maintained for the
safe interpreter in the master, and returns the token that can be used in
safe interpreter in the parent, and returns the token that can be used in
the safe interpreter to obtain access to files in that directory.
If the directory is already in the virtual path, it only returns the token
without adding the directory to the virtual path again.
@@ -135,7 +135,7 @@ Example of use:
.RS
.PP
.CS
$slave eval [list set tk_library \e
$child eval [list set tk_library \e
[::safe::interpAddToAccessPath $name $tk_library]]
.CE
.RE
@@ -168,10 +168,10 @@ Note that the safe interpreter only received an error message saying that
the file was not found:
.PP
.CS
NOTICE for slave interp10 : Created
NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
NOTICE for child interp10 : Created
NOTICE for child interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
NOTICE for child interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for child interp10 : /foo/bar/init.tcl: no such file or directory
.CE
.RE
.SS OPTIONS
@@ -187,7 +187,7 @@ This option sets the list of directories from which the safe interpreter
can \fBsource\fR and \fBload\fR files.
If this option is not specified, or if it is given as the
empty list, the safe interpreter will use the same directories as its
master for auto-loading.
parent for auto-loading.
See the section \fBSECURITY\fR below for more detail about virtual paths,
tokens and access control.
.TP
@@ -216,7 +216,7 @@ to load packages into its own sub-interpreters.
.TP
\fB\-deleteHook\fR \fIscript\fR
When this option is given a non-empty \fIscript\fR, it will be
evaluated in the master with the name of
evaluated in the parent with the name of
the safe interpreter as an additional argument
just before actually deleting the safe interpreter.
Giving an empty value removes any currently installed deletion hook
@@ -281,8 +281,8 @@ potential for information leakage about its directory structure.
To prevent this, commands that take file names as arguments in a safe
interpreter use tokens instead of the real directory names.
These tokens are translated to the real directory name while a request to,
e.g., source a file is mediated by the master interpreter.
This virtual path system is maintained in the master interpreter for each safe
e.g., source a file is mediated by the parent interpreter.
This virtual path system is maintained in the parent interpreter for each safe
interpreter created by \fB::safe::interpCreate\fR or initialized by
\fB::safe::interpInit\fR and
the path maps tokens accessible in the safe interpreter into real path
@@ -291,7 +291,7 @@ from gaining knowledge about the
structure of the file system of the host on which the interpreter is
executing.
The only valid file names arguments
for the \fBsource\fR and \fBload\fR aliases provided to the slave
for the \fBsource\fR and \fBload\fR aliases provided to the child
are path in the form of
\fB[file join \fItoken filename\fB]\fR (i.e. when using the
native file path formats: \fItoken\fB/\fIfilename\fR
@@ -320,26 +320,26 @@ or be called
.PP
Each element of the initial access path
list will be assigned a token that will be set in
the slave \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that slave.
the child \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that child.
.PP
If the access path argument is not given or is the empty list,
the default behavior is to let the slave access the same packages
as the master has access to (Or to be more precise:
the default behavior is to let the child access the same packages
as the parent has access to (Or to be more precise:
only packages written in Tcl (which by definition cannot be dangerous
as they run in the slave interpreter) and C extensions that
provides a _SafeInit entry point). For that purpose, the master's
\fBauto_path\fR will be used to construct the slave access path.
In order that the slave successfully loads the Tcl library files
as they run in the child interpreter) and C extensions that
provides a _SafeInit entry point). For that purpose, the parent's
\fBauto_path\fR will be used to construct the child access path.
In order that the child successfully loads the Tcl library files
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
added or moved to the first position if necessary, in the
slave access path, so the slave
\fBtcl_library\fR will be the same as the master's (its real
path will still be invisible to the slave though).
In order that auto-loading works the same for the slave and
the master in this by default case, the first-level
sub directories of each directory in the master \fBauto_path\fR will
also be added (if not already included) to the slave access path.
child access path, so the child
\fBtcl_library\fR will be the same as the parent's (its real
path will still be invisible to the child though).
In order that auto-loading works the same for the child and
the parent in this by default case, the first-level
sub directories of each directory in the parent \fBauto_path\fR will
also be added (if not already included) to the child access path.
You can always specify a more
restrictive path for which sub directories will never be searched by
explicitly specifying your directory list with the \fB\-accessPath\fR flag
@@ -352,8 +352,8 @@ to synchronize its \fBauto_index\fR with the new token list.
.SH "SEE ALSO"
interp(n), library(n), load(n), package(n), source(n), unknown(n)
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source
alias, auto\-loading, auto_mkindex, load, parent interpreter, safe
interpreter, child interpreter, source
'\" Local Variables:
'\" mode: nroff
'\" End:
+8 -8
View File
@@ -203,7 +203,7 @@ array. Returns an empty string.
.TP
\fBrunAllTests\fR
.
This is a master command meant to run an entire suite of tests,
This is a main command meant to run an entire suite of tests,
spanning multiple files and/or directories, as governed by
the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR
below for a complete description of the many variations possible
@@ -804,17 +804,17 @@ then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
evaluate each file. The multi-process operation is useful
when testing can cause errors so severe that a process
terminates. Although such an error may terminate a child
process evaluating one file, the master process can continue
process evaluating one file, the main process can continue
with the rest of the test suite. In multi-process operation,
the configuration of \fBtcltest\fR in the master process is
the configuration of \fBtcltest\fR in the main process is
passed to the child processes as command line arguments,
with the exception of \fBconfigure \-outfile\fR. The
\fBrunAllTests\fR command in the
master process collects all output from the child processes
and collates their results into one master report. Any
main process collects all output from the child processes
and collates their results into one main report. Any
reports of individual test failures, or messages requested
by a \fBconfigure \-verbose\fR setting are passed directly
on to \fBoutputChannel\fR by the master process.
on to \fBoutputChannel\fR by the main process.
.PP
After evaluating all selected test files, a summary of the
results is printed to \fBoutputChannel\fR. The summary
@@ -1134,7 +1134,7 @@ A good namespace to use is a child namespace \fBtest\fR of the namespace
of the module you are testing.
.PP
A test file should also be able to be evaluated directly as a script,
not depending on being called by a master \fBrunAllTests\fR. This
not depending on being called by a main \fBrunAllTests\fR. This
means that each test file should process command line arguments to give
the tester all the configuration control that \fBtcltest\fR provides.
.PP
@@ -1175,7 +1175,7 @@ doing any necessary setup. This script is usually named \fBall.tcl\fR
because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
Here is a sketch of a sample test suite master script:
Here is a sketch of a sample test suite main script:
.RS
.PP
.CS
+1 -1
View File
@@ -73,7 +73,7 @@ struct dfa {
chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
struct sset *search; /* replacement-search-pointer memory */
int cptsmalloced; /* were the areas individually malloced? */
char *mallocarea; /* self, or master malloced area, or NULL */
char *mallocarea; /* self, or main malloced area, or NULL */
};
#define WORK 1 /* number of work bitvectors needed */
+7 -7
View File
@@ -316,12 +316,12 @@ declare 85 {
int flags)
}
declare 86 {
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
int Tcl_CreateAlias(Tcl_Interp *child, const char *childCmd,
Tcl_Interp *target, const char *targetCmd, int argc,
CONST84 char *const *argv)
}
declare 87 {
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
int Tcl_CreateAliasObj(Tcl_Interp *child, const char *childCmd,
Tcl_Interp *target, const char *targetCmd, int objc,
Tcl_Obj *const objv[])
}
@@ -364,7 +364,7 @@ declare 96 {
Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
int isSafe)
}
declare 98 {
@@ -527,12 +527,12 @@ declare 147 {
void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 {
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *argcPtr, CONST84 char ***argvPtr)
}
declare 149 {
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
@@ -582,7 +582,7 @@ declare 162 {
CONST84_RETURN char *Tcl_GetHostName(void)
}
declare 163 {
int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *slaveInterp)
int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp)
}
declare 164 {
Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
@@ -616,7 +616,7 @@ declare 171 {
int Tcl_GetServiceMode(void)
}
declare 172 {
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *name)
}
declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
+4 -4
View File
@@ -3443,11 +3443,11 @@ CancelEvalProc(
TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
/*
* Now, we must set the script cancellation flags on all the slave
* Now, we must set the script cancellation flags on all the child
* interpreters belonging to this one.
*/
TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
TclSetChildCancelFlags((Tcl_Interp *) iPtr,
cancelInfo->flags | CANCELED, 0);
/*
@@ -3966,7 +3966,7 @@ TclResetCancellation(
* Tcl_Canceled --
*
* Check if the script in progress has been canceled, i.e.,
* Tcl_CancelEval was called for this interpreter or any of its master
* Tcl_CancelEval was called for this interpreter or any of its parent
* interpreters.
*
* Results:
@@ -5046,7 +5046,7 @@ TclEvalEx(
* the embedded command, which is refered to
* by 'script'. The 'clNextOuter' refers to
* the current entry in the table of
* continuation lines in this "master script",
* continuation lines in this "parent script",
* and the character offsets are relative to
* the 'outerScript' as well.
*
+1 -1
View File
@@ -263,7 +263,7 @@ TclClockInit(
};
/*
* Safe interps get [::clock] as alias to a master, so do not need their
* Safe interps get [::clock] as alias to a parent, so do not need their
* own copies of the support routines.
*/
+1 -1
View File
@@ -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;
}
+1 -1
View File
@@ -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);
+17 -18
View File
@@ -279,13 +279,13 @@ EXTERN int Tcl_ConvertElement(const char *src, char *dst,
EXTERN int Tcl_ConvertCountedElement(const char *src,
int length, char *dst, int flags);
/* 86 */
EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
EXTERN int Tcl_CreateAlias(Tcl_Interp *child,
const char *childCmd, Tcl_Interp *target,
const char *targetCmd, int argc,
CONST84 char *const *argv);
/* 87 */
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *child,
const char *childCmd, Tcl_Interp *target,
const char *targetCmd, int objc,
Tcl_Obj *const objv[]);
/* 88 */
@@ -323,8 +323,8 @@ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
/* 97 */
EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp,
const char *slaveName, int isSafe);
EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
int isSafe);
/* 98 */
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
Tcl_TimerProc *proc, ClientData clientData);
@@ -458,13 +458,13 @@ EXTERN int Tcl_Flush(Tcl_Channel chan);
EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
const char *slaveCmd,
const char *childCmd,
Tcl_Interp **targetInterpPtr,
CONST84 char **targetCmdPtr, int *argcPtr,
CONST84 char ***argvPtr);
/* 149 */
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
const char *slaveCmd,
const char *childCmd,
Tcl_Interp **targetInterpPtr,
CONST84 char **targetCmdPtr, int *objcPtr,
Tcl_Obj ***objv);
@@ -504,7 +504,7 @@ EXTERN int Tcl_GetErrno(void);
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
/* 163 */
EXTERN int Tcl_GetInterpPath(Tcl_Interp *interp,
Tcl_Interp *slaveInterp);
Tcl_Interp *childInterp);
/* 164 */
EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
/* 165 */
@@ -532,8 +532,7 @@ EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
EXTERN int Tcl_GetServiceMode(void);
/* 172 */
EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
const char *slaveName);
EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *name);
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
@@ -1949,8 +1948,8 @@ typedef struct TclStubs {
char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
int (*tcl_CreateAlias) (Tcl_Interp *child, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *child, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
@@ -1960,7 +1959,7 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
@@ -2011,8 +2010,8 @@ typedef struct TclStubs {
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
@@ -2026,7 +2025,7 @@ typedef struct TclStubs {
CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *slaveInterp); /* 163 */
int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
@@ -2043,7 +2042,7 @@ typedef struct TclStubs {
int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
int (*tcl_GetServiceMode) (void); /* 171 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *name); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
+2 -2
View File
@@ -1043,7 +1043,7 @@ TclInitSubsystems(void)
* implementation of self-initializing locks.
*/
TclInitThreadStorage(); /* Creates master hash table for
TclInitThreadStorage(); /* Creates main hash table for
* thread local storage */
#if USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
@@ -1157,7 +1157,7 @@ Tcl_Finalize(void)
TclFinalizeFilesystem();
/*
* Undo all Tcl_ObjType registrations, and reset the master list of free
* Undo all Tcl_ObjType registrations, and reset the main list of free
* Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
* freed.
*
+1 -1
View File
@@ -4619,7 +4619,7 @@ Tcl_FSGetFileSystemForPath(
/*
* Check if the filesystem has changed in some way since this object's
* internal representation was calculated. Before doing that, assure we
* have the most up-to-date copy of the master filesystem. This is
* have the most up-to-date copy of the main filesystem. This is
* accomplished by the FsGetFirstFilesystem() call.
*/
+548 -548
View File
File diff suppressed because it is too large Load Diff
+5 -5
View File
@@ -196,9 +196,9 @@ Tcl_LoadObjCmd(
target = interp;
if (objc == 4) {
const char *slaveIntName = Tcl_GetString(objv[3]);
const char *childIntName = Tcl_GetString(objv[3]);
target = Tcl_GetSlave(interp, slaveIntName);
target = Tcl_GetChild(interp, childIntName);
if (target == NULL) {
code = TCL_ERROR;
goto done;
@@ -619,9 +619,9 @@ Tcl_UnloadObjCmd(
target = interp;
if (objc - i == 3) {
const char *slaveIntName = Tcl_GetString(objv[i + 2]);
const char *childIntName = Tcl_GetString(objv[i + 2]);
target = Tcl_GetSlave(interp, slaveIntName);
target = Tcl_GetChild(interp, childIntName);
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;
}
+1 -1
View File
@@ -132,7 +132,7 @@ static const Tcl_MethodType classConstructor = {
};
/*
* Scripted parts of TclOO. First, the master script (cannot be outside this
* Scripted parts of TclOO. First, the main script (cannot be outside this
* file).
*/
+1 -1
View File
@@ -110,7 +110,7 @@ TclOOInitInfo(
TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);
/*
* Install into the master [info] ensemble.
* Install into the main [info] ensemble.
*/
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
+2 -2
View File
@@ -277,7 +277,7 @@ typedef struct Class {
*/
typedef struct ThreadLocalData {
int nsCount; /* Master epoch counter is used for keeping
int nsCount; /* Main epoch counter is used for keeping
* the values used in Tcl_Obj internal
* representations sane. Must be thread-local
* because Tcl_Objs can cross interpreter
@@ -289,7 +289,7 @@ typedef struct Foundation {
Tcl_Interp *interp;
Class *objectCls; /* The root of the object system. */
Class *classCls; /* The class of all classes. */
Tcl_Namespace *ooNs; /* Master ::oo namespace. */
Tcl_Namespace *ooNs; /* Main ::oo namespace. */
Tcl_Namespace *defineNs; /* Namespace containing special commands for
* manipulating objects and classes. The
* "oo::define" command acts as a special kind
+1 -1
View File
@@ -2172,7 +2172,7 @@ TclSubstTokens(
* command, which is refered to by 'script'.
* The 'clNextOuter' refers to the current
* entry in the table of continuation lines in
* this "master script", and the character
* this "main script", and the character
* offsets are relative to the 'outerScript'
* as well.
*
+9 -9
View File
@@ -1506,15 +1506,15 @@ TestdelCmd(
const char **argv) /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
Tcl_Interp *child;
if (argc != 4) {
Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
return TCL_ERROR;
}
slave = Tcl_GetSlave(interp, argv[1]);
if (slave == NULL) {
child = Tcl_GetChild(interp, argv[1]);
if (child == NULL) {
return TCL_ERROR;
}
@@ -1523,7 +1523,7 @@ TestdelCmd(
dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
strcpy(dPtr->deleteCmd, argv[3]);
Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
Tcl_CreateCommand(child, argv[2], DelCmdProc, (ClientData) dPtr,
DelDeleteProc);
return TCL_OK;
}
@@ -2689,18 +2689,18 @@ TestinterpdeleteCmd(
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
Tcl_Interp *slaveToDelete;
Tcl_Interp *childToDelete;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" path\"", NULL);
return TCL_ERROR;
}
slaveToDelete = Tcl_GetSlave(interp, argv[1]);
if (slaveToDelete == NULL) {
childToDelete = Tcl_GetChild(interp, argv[1]);
if (childToDelete == NULL) {
return TCL_ERROR;
}
Tcl_DeleteInterp(slaveToDelete);
Tcl_DeleteInterp(childToDelete);
return TCL_OK;
}
@@ -7731,7 +7731,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;
+1 -1
View File
@@ -377,7 +377,7 @@ proc auto_mkindex_parser::mkindex {file} {
# auto_mkindex_parser::hook command
#
# Registers a Tcl command to evaluate when initializing the slave interpreter
# used by the mkindex parser. The command is evaluated in the master
# used by the mkindex parser. The command is evaluated in the parent
# interpreter, and can use the variable auto_mkindex_parser::parser to get to
# the slave
+2 -2
View File
@@ -3304,7 +3304,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
return
}
# Since an unsafe interp uses the [clock] command in the master, this code
# Since an unsafe interp uses the [clock] command in the parent, this code
# is security sensitive. Make sure that the path name cannot escape the
# given directory.
@@ -3344,7 +3344,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
proc ::tcl::clock::LoadZoneinfoFile { fileName } {
variable ZoneinfoPaths
# Since an unsafe interp uses the [clock] command in the master, this code
# Since an unsafe interp uses the [clock] command in the parent, this code
# is security sensitive. Make sure that the path name cannot escape the
# given directory.
+2 -2
View File
@@ -44,8 +44,8 @@ namespace eval ::tcl {
{-intflag 7}
{-weirdflag "help string"}
{-noStatics "Not ok to load static packages"}
{-nestedloading1 true "OK to load into nested slaves"}
{-nestedloading2 -boolean true "OK to load into nested slaves"}
{-nestedloading1 true "OK to load into nested children"}
{-nestedloading2 -boolean true "OK to load into nested children"}
{-libsOK -choice {Tk SybTcl}
"List of packages that can be loaded"}
{-precision -int 12 "Number of digits of precision"}
+1 -1
View File
@@ -237,7 +237,7 @@ proc pkg_mkIndex {args} {
$c eval [list set ::tcl::file $file]
$c eval [list set ::tcl::direct $direct]
# Download needed procedures into the slave because we've just deleted
# Download needed procedures into the child because we've just deleted
# the unknown procedure. This doesn't handle procedures with default
# arguments.
+189 -189
View File
@@ -1,9 +1,9 @@
# safe.tcl --
#
# This file provide a safe loading/sourcing mechanism for safe interpreters.
# It implements a virtual path mecanism to hide the real pathnames from the
# slave. It runs in a master interpreter and sets up data structure and
# aliases that will be invoked when used from a slave interpreter.
# It implements a virtual path mechanism to hide the real pathnames from the
# child. It runs in a parent interpreter and sets up data structure and
# aliases that will be invoked when used from a child interpreter.
#
# See the safe.n man page for details.
#
@@ -79,25 +79,25 @@ proc ::safe::InterpNested {} {
# Interface/entry point function and front end for "Create"
proc ::safe::interpCreate {args} {
set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
InterpCreate $slave $accessPath \
InterpCreate $child $accessPath \
[InterpStatics] [InterpNested] $deleteHook
}
proc ::safe::interpInit {args} {
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
if {![::interp exists $slave]} {
return -code error "\"$slave\" is not an interpreter"
if {![::interp exists $child]} {
return -code error "\"$child\" is not an interpreter"
}
InterpInit $slave $accessPath \
InterpInit $child $accessPath \
[InterpStatics] [InterpNested] $deleteHook
}
# Check that the given slave is "one of us"
proc ::safe::CheckInterp {slave} {
namespace upvar ::safe S$slave state
if {![info exists state] || ![::interp exists $slave]} {
# Check that the given child is "one of us"
proc ::safe::CheckInterp {child} {
namespace upvar ::safe S$child state
if {![info exists state] || ![::interp exists $child]} {
return -code error \
"\"$slave\" is not an interpreter managed by ::safe::"
"\"$child\" is not an interpreter managed by ::safe::"
}
}
@@ -119,11 +119,11 @@ proc ::safe::interpConfigure {args} {
1 {
# If we have exactly 1 argument the semantic is to return all
# the current configuration. We still call OptKeyParse though
# we know that "slave" is our given argument because it also
# we know that "child" is our given argument because it also
# checks for the "-help" option.
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
CheckInterp $slave
namespace upvar ::safe S$slave state
CheckInterp $child
namespace upvar ::safe S$child state
return [join [list \
[list -accessPath $state(access_path)] \
@@ -134,7 +134,7 @@ proc ::safe::interpConfigure {args} {
2 {
# If we have exactly 2 arguments the semantic is a "configure
# get"
lassign $args slave arg
lassign $args child arg
# get the flag sub program (we 'know' about Opt's internal
# representation of data)
@@ -145,8 +145,8 @@ proc ::safe::interpConfigure {args} {
} elseif {$hits == 0} {
return -code error [::tcl::OptFlagUsage $desc $arg]
}
CheckInterp $slave
namespace upvar ::safe S$slave state
CheckInterp $child
namespace upvar ::safe S$child state
set item [::tcl::OptCurDesc $desc]
set name [::tcl::OptName $item]
@@ -186,8 +186,8 @@ proc ::safe::interpConfigure {args} {
# Otherwise we want to parse the arguments like init and
# create did
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
CheckInterp $slave
namespace upvar ::safe S$slave state
CheckInterp $child
namespace upvar ::safe S$child state
# Get the current (and not the default) values of whatever has
# not been given:
@@ -217,13 +217,13 @@ proc ::safe::interpConfigure {args} {
set deleteHook $state(cleanupHook)
}
# we can now reconfigure :
InterpSetConfig $slave $accessPath $statics $nested $deleteHook
# auto_reset the slave (to completly synch the new access_path)
InterpSetConfig $child $accessPath $statics $nested $deleteHook
# auto_reset the child (to completly synch the new access_path)
if {$doreset} {
if {[catch {::interp eval $slave {auto_reset}} msg]} {
Log $slave "auto_reset failed: $msg"
if {[catch {::interp eval $child {auto_reset}} msg]} {
Log $child "auto_reset failed: $msg"
} else {
Log $slave "successful auto_reset" NOTICE
Log $child "successful auto_reset" NOTICE
}
}
}
@@ -239,17 +239,17 @@ proc ::safe::interpConfigure {args} {
#
# safe::InterpCreate : doing the real job
#
# This procedure creates a safe slave and initializes it with the safe
# This procedure creates a safe child and initializes it with the safe
# base aliases.
# NB: slave name must be simple alphanumeric string, no spaces, no (), no
# NB: child name must be simple alphanumeric string, no spaces, no (), no
# {},... {because the state array is stored as part of the name}
#
# Returns the slave name.
# Returns the child name.
#
# Optional Arguments :
# + slave name : if empty, generated name will be used
# + child name : if empty, generated name will be used
# + access_path: path list controlling where load/source can occur,
# if empty: the master auto_path will be used.
# if empty: the parent auto_path will be used.
# + staticsok : flag, if 0 :no static package can be loaded (load {} Xxx)
# if 1 :static packages are ok.
# + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
@@ -257,35 +257,35 @@ proc ::safe::interpConfigure {args} {
# use the full name and no indent so auto_mkIndex can find us
proc ::safe::InterpCreate {
slave
child
access_path
staticsok
nestedok
deletehook
} {
# Create the slave.
if {$slave ne ""} {
::interp create -safe $slave
# Create the child.
if {$child ne ""} {
::interp create -safe $child
} else {
# empty argument: generate slave name
set slave [::interp create -safe]
# empty argument: generate child name
set child [::interp create -safe]
}
Log $slave "Created" NOTICE
Log $child "Created" NOTICE
# Initialize it. (returns slave name)
InterpInit $slave $access_path $staticsok $nestedok $deletehook
# Initialize it. (returns child name)
InterpInit $child $access_path $staticsok $nestedok $deletehook
}
#
# InterpSetConfig (was setAccessPath) :
# Sets up slave virtual auto_path and corresponding structure within
# the master. Also sets the tcl_library in the slave to be the first
# Sets up child virtual auto_path and corresponding structure within
# the parent. Also sets the tcl_library in the child to be the first
# directory in the path.
# NB: If you change the path after the slave has been initialized you
# probably need to call "auto_reset" in the slave in order that it gets
# NB: If you change the path after the child has been initialized you
# probably need to call "auto_reset" in the child in order that it gets
# the right auto_index() array values.
proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
proc ::safe::InterpSetConfig {child access_path staticsok nestedok deletehook} {
global auto_path
# determine and store the access path if empty
@@ -298,45 +298,45 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
if {$where == -1} {
# not found, add it.
set access_path [linsert $access_path 0 [info library]]
Log $slave "tcl_library was not in auto_path,\
added it to slave's access_path" NOTICE
Log $child "tcl_library was not in auto_path,\
added it to child's access_path" NOTICE
} elseif {$where != 0} {
# not first, move it first
set access_path [linsert \
[lreplace $access_path $where $where] \
0 [info library]]
Log $slave "tcl_libray was not in first in auto_path,\
moved it to front of slave's access_path" NOTICE
Log $child "tcl_libray was not in first in auto_path,\
moved it to front of child's access_path" NOTICE
}
# Add 1st level sub dirs (will searched by auto loading from tcl
# code in the slave using glob and thus fail, so we add them here
# code in the child using glob and thus fail, so we add them here
# so by default it works the same).
set access_path [AddSubDirs $access_path]
}
Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
Log $child "Setting accessPath=($access_path) staticsok=$staticsok\
nestedok=$nestedok deletehook=($deletehook)" NOTICE
namespace upvar ::safe S$slave state
namespace upvar ::safe S$child state
# clear old autopath if it existed
# build new one
# Extend the access list with the paths used to look for Tcl Modules.
# We save the virtual form separately as well, as syncing it with the
# slave has to be defered until the necessary commands are present for
# child has to be defered until the necessary commands are present for
# setup.
set norm_access_path {}
set slave_access_path {}
set child_access_path {}
set map_access_path {}
set remap_access_path {}
set slave_tm_path {}
set child_tm_path {}
set i 0
foreach dir $access_path {
set token [PathToken $i]
lappend slave_access_path $token
lappend child_access_path $token
lappend map_access_path $token $dir
lappend remap_access_path $dir $token
lappend norm_access_path [file normalize $dir]
@@ -357,11 +357,11 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
set token [PathToken $i]
lappend access_path $dir
lappend slave_access_path $token
lappend child_access_path $token
lappend map_access_path $token $dir
lappend remap_access_path $dir $token
lappend norm_access_path [file normalize $dir]
lappend slave_tm_path $token
lappend child_tm_path $token
incr i
# [Bug 2854929]
@@ -378,13 +378,13 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
set state(access_path,map) $map_access_path
set state(access_path,remap) $remap_access_path
set state(access_path,norm) $norm_access_path
set state(access_path,slave) $slave_access_path
set state(tm_path_slave) $slave_tm_path
set state(access_path,child) $child_access_path
set state(tm_path_child) $child_tm_path
set state(staticsok) $staticsok
set state(nestedok) $nestedok
set state(cleanupHook) $deletehook
SyncAccessPath $slave
SyncAccessPath $child
}
#
@@ -392,8 +392,8 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
# FindInAccessPath:
# Search for a real directory and returns its virtual Id (including the
# "$")
proc ::safe::interpFindInAccessPath {slave path} {
namespace upvar ::safe S$slave state
proc ::safe::interpFindInAccessPath {child path} {
namespace upvar ::safe S$child state
if {![dict exists $state(access_path,remap) $path]} {
return -code error "$path not found in access path $access_path"
@@ -406,10 +406,10 @@ proc ::safe::interpFindInAccessPath {slave path} {
# addToAccessPath:
# add (if needed) a real directory to access path and return its
# virtual token (including the "$").
proc ::safe::interpAddToAccessPath {slave path} {
proc ::safe::interpAddToAccessPath {child path} {
# first check if the directory is already in there
# (inlined interpFindInAccessPath).
namespace upvar ::safe S$slave state
namespace upvar ::safe S$child state
if {[dict exists $state(access_path,remap) $path]} {
return [dict get $state(access_path,remap) $path]
@@ -419,12 +419,12 @@ proc ::safe::interpAddToAccessPath {slave path} {
set token [PathToken [llength $state(access_path)]]
lappend state(access_path) $path
lappend state(access_path,slave) $token
lappend state(access_path,child) $token
lappend state(access_path,map) $token $path
lappend state(access_path,remap) $path $token
lappend state(access_path,norm) [file normalize $path]
SyncAccessPath $slave
SyncAccessPath $child
return $token
}
@@ -432,25 +432,25 @@ proc ::safe::interpAddToAccessPath {slave path} {
# interpreter. It is useful when you want to install the safe base aliases
# into a preexisting safe interpreter.
proc ::safe::InterpInit {
slave
child
access_path
staticsok
nestedok
deletehook
} {
# Configure will generate an access_path when access_path is empty.
InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook
InterpSetConfig $child $access_path $staticsok $nestedok $deletehook
# NB we need to add [namespace current], aliases are always absolute
# paths.
# These aliases let the slave load files to define new commands
# This alias lets the slave use the encoding names, convertfrom,
# These aliases let the child load files to define new commands
# This alias lets the child use the encoding names, convertfrom,
# convertto, and system, but not "encoding system <name>" to set the
# system encoding.
# Handling Tcl Modules, we need a restricted form of Glob.
# This alias interposes on the 'exit' command and cleanly terminates
# the slave.
# the child.
foreach {command alias} {
source AliasSource
@@ -459,61 +459,61 @@ proc ::safe::InterpInit {
exit interpDelete
glob AliasGlob
} {
::interp alias $slave $command {} [namespace current]::$alias $slave
::interp alias $child $command {} [namespace current]::$alias $child
}
# This alias lets the slave have access to a subset of the 'file'
# This alias lets the child have access to a subset of the 'file'
# command functionality.
::interp expose $slave file
::interp expose $child file
foreach subcommand {dirname extension rootname tail} {
::interp alias $slave ::tcl::file::$subcommand {} \
::safe::AliasFileSubcommand $slave $subcommand
::interp alias $child ::tcl::file::$subcommand {} \
::safe::AliasFileSubcommand $child $subcommand
}
foreach subcommand {
atime attributes copy delete executable exists isdirectory isfile
link lstat mtime mkdir nativename normalize owned readable readlink
rename size stat tempfile type volumes writable
} {
::interp alias $slave ::tcl::file::$subcommand {} \
::safe::BadSubcommand $slave file $subcommand
::interp alias $child ::tcl::file::$subcommand {} \
::safe::BadSubcommand $child file $subcommand
}
# Subcommands of info
foreach {subcommand alias} {
nameofexecutable AliasExeName
} {
::interp alias $slave ::tcl::info::$subcommand \
{} [namespace current]::$alias $slave
::interp alias $child ::tcl::info::$subcommand \
{} [namespace current]::$alias $child
}
# The allowed slave variables already have been set by Tcl_MakeSafe(3)
# The allowed child variables already have been set by Tcl_MakeSafe(3)
# Source init.tcl and tm.tcl into the slave, to get auto_load and
# Source init.tcl and tm.tcl into the child, to get auto_load and
# other procedures defined:
if {[catch {::interp eval $slave {
if {[catch {::interp eval $child {
source [file join $tcl_library init.tcl]
}} msg opt]} {
Log $slave "can't source init.tcl ($msg)"
return -options $opt "can't source init.tcl into slave $slave ($msg)"
Log $child "can't source init.tcl ($msg)"
return -options $opt "can't source init.tcl into child $child ($msg)"
}
if {[catch {::interp eval $slave {
if {[catch {::interp eval $child {
source [file join $tcl_library tm.tcl]
}} msg opt]} {
Log $slave "can't source tm.tcl ($msg)"
return -options $opt "can't source tm.tcl into slave $slave ($msg)"
Log $child "can't source tm.tcl ($msg)"
return -options $opt "can't source tm.tcl into child $child ($msg)"
}
# Sync the paths used to search for Tcl modules. This can be done only
# now, after tm.tcl was loaded.
namespace upvar ::safe S$slave state
if {[llength $state(tm_path_slave)] > 0} {
::interp eval $slave [list \
::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
namespace upvar ::safe S$child state
if {[llength $state(tm_path_child)] > 0} {
::interp eval $child [list \
::tcl::tm::add {*}[lreverse $state(tm_path_child)]]
}
return $slave
return $child
}
# Add (only if needed, avoid duplicates) 1 level of sub directories to an
@@ -539,15 +539,15 @@ proc ::safe::AddSubDirs {pathList} {
return $res
}
# This procedure deletes a safe slave managed by Safe Tcl and cleans up
# This procedure deletes a safe child managed by Safe Tcl and cleans up
# associated state:
proc ::safe::interpDelete {slave} {
Log $slave "About to delete" NOTICE
proc ::safe::interpDelete {child} {
Log $child "About to delete" NOTICE
namespace upvar ::safe S$slave state
namespace upvar ::safe S$child state
# If the slave has a cleanup hook registered, call it. Check the
# If the child has a cleanup hook registered, call it. Check the
# existance because we might be called to delete an interp which has
# not been registered with us at all
@@ -558,14 +558,14 @@ proc ::safe::interpDelete {slave} {
# we'll loop
unset state(cleanupHook)
try {
{*}$hook $slave
{*}$hook $child
} on error err {
Log $slave "Delete hook error ($err)"
Log $child "Delete hook error ($err)"
}
}
}
# Discard the global array of state associated with the slave, and
# Discard the global array of state associated with the child, and
# delete the interpreter.
if {[info exists state]} {
@@ -574,9 +574,9 @@ proc ::safe::interpDelete {slave} {
# if we have been called twice, the interp might have been deleted
# already
if {[::interp exists $slave]} {
::interp delete $slave
Log $slave "Deleted" NOTICE
if {[::interp exists $child]} {
::interp delete $child
Log $child "Deleted" NOTICE
}
return
@@ -602,9 +602,9 @@ proc ::safe::setLogCmd {args} {
} else {
# Activate logging, define proper command.
proc ::safe::Log {slave msg {type ERROR}} {
proc ::safe::Log {child msg {type ERROR}} {
variable Log
{*}$Log "$type for slave $slave : $msg"
{*}$Log "$type for child $child : $msg"
return
}
}
@@ -613,24 +613,24 @@ proc ::safe::setLogCmd {args} {
# ------------------- END OF PUBLIC METHODS ------------
#
# Sets the slave auto_path to the master recorded value. Also sets
# Sets the child auto_path to the parent recorded value. Also sets
# tcl_library to the first token of the virtual path.
#
proc ::safe::SyncAccessPath {slave} {
namespace upvar ::safe S$slave state
proc ::safe::SyncAccessPath {child} {
namespace upvar ::safe S$child state
set slave_access_path $state(access_path,slave)
::interp eval $slave [list set auto_path $slave_access_path]
set child_access_path $state(access_path,child)
::interp eval $child [list set auto_path $child_access_path]
Log $slave "auto_path in $slave has been set to $slave_access_path"\
Log $child "auto_path in $child has been set to $child_access_path"\
NOTICE
# This code assumes that info library is the first element in the
# list of auto_path's. See -> InterpSetConfig for the code which
# ensures this condition.
::interp eval $slave [list \
set tcl_library [lindex $slave_access_path 0]]
::interp eval $child [list \
set tcl_library [lindex $child_access_path 0]]
}
# Returns the virtual token for directory number N.
@@ -643,8 +643,8 @@ proc ::safe::PathToken {n} {
#
# translate virtual path into real path
#
proc ::safe::TranslatePath {slave path} {
namespace upvar ::safe S$slave state
proc ::safe::TranslatePath {child path} {
namespace upvar ::safe S$child state
# somehow strip the namespaces 'functionality' out (the danger is that
# we would strip valid macintosh "../" queries... :
@@ -659,7 +659,7 @@ proc ::safe::TranslatePath {slave path} {
# file name control (limit access to files/resources that should be a
# valid tcl source file)
proc ::safe::CheckFileName {slave file} {
proc ::safe::CheckFileName {child file} {
# This used to limit what can be sourced to ".tcl" and forbid files
# with more than 1 dot and longer than 14 chars, but I changed that
# for 8.4 as a safe interp has enough internal protection already to
@@ -680,17 +680,17 @@ proc ::safe::CheckFileName {slave file} {
# interpreters that are *almost* safe. In particular, it just acts to
# prevent discovery of what home directories exist.
proc ::safe::AliasFileSubcommand {slave subcommand name} {
proc ::safe::AliasFileSubcommand {child subcommand name} {
if {[string match ~* $name]} {
set name ./$name
}
tailcall ::interp invokehidden $slave tcl:file:$subcommand $name
tailcall ::interp invokehidden $child tcl:file:$subcommand $name
}
# AliasGlob is the target of the "glob" alias in safe interpreters.
proc ::safe::AliasGlob {slave args} {
Log $slave "GLOB ! $args" NOTICE
proc ::safe::AliasGlob {child args} {
Log $child "GLOB ! $args" NOTICE
set cmd {}
set at 0
array set got {
@@ -738,7 +738,7 @@ proc ::safe::AliasGlob {slave args} {
return -code error "unknown command glob"
}
-* {
Log $slave "Safe base rejecting glob option '$opt'"
Log $child "Safe base rejecting glob option '$opt'"
return -code error "Safe base rejecting glob option '$opt'"
}
default {
@@ -749,14 +749,14 @@ proc ::safe::AliasGlob {slave args} {
}
# Get the real path from the virtual one and check that the path is in the
# access path of that slave. Done after basic argument processing so that
# access path of that child. Done after basic argument processing so that
# we know if -nocomplain is set.
if {$got(-directory)} {
try {
set dir [TranslatePath $slave $virtualdir]
DirInAccessPath $slave $dir
set dir [TranslatePath $child $virtualdir]
DirInAccessPath $child $dir
} on error msg {
Log $slave $msg
Log $child $msg
if {$got(-nocomplain)} return
return -code error "permission denied"
}
@@ -779,11 +779,11 @@ proc ::safe::AliasGlob {slave args} {
if {$thedir eq "*" &&
($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} {
set mapped 0
foreach d [glob -directory [TranslatePath $slave $virtualdir] \
foreach d [glob -directory [TranslatePath $child $virtualdir] \
-types d -tails *] {
catch {
DirInAccessPath $slave \
[TranslatePath $slave [file join $virtualdir $d]]
DirInAccessPath $child \
[TranslatePath $child [file join $virtualdir $d]]
lappend cmd [file join $d $thefile]
set mapped 1
}
@@ -791,31 +791,31 @@ proc ::safe::AliasGlob {slave args} {
if {$mapped} continue
}
try {
DirInAccessPath $slave [TranslatePath $slave \
DirInAccessPath $child [TranslatePath $child \
[file join $virtualdir $thedir]]
} on error msg {
Log $slave $msg
Log $child $msg
if {$got(-nocomplain)} continue
return -code error "permission denied"
}
lappend cmd $opt
}
Log $slave "GLOB = $cmd" NOTICE
Log $child "GLOB = $cmd" NOTICE
if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
return
}
try {
set entries [::interp invokehidden $slave glob {*}$cmd]
set entries [::interp invokehidden $child glob {*}$cmd]
} on error msg {
Log $slave $msg
Log $child $msg
return -code error "script error"
}
Log $slave "GLOB < $entries" NOTICE
Log $child "GLOB < $entries" NOTICE
# Translate path back to what the slave should see.
# Translate path back to what the child should see.
set res {}
set l [string length $dir]
foreach p $entries {
@@ -825,13 +825,13 @@ proc ::safe::AliasGlob {slave args} {
lappend res $p
}
Log $slave "GLOB > $res" NOTICE
Log $child "GLOB > $res" NOTICE
return $res
}
# AliasSource is the target of the "source" alias in safe interpreters.
proc ::safe::AliasSource {slave args} {
proc ::safe::AliasSource {child args} {
set argc [llength $args]
# Extended for handling of Tcl Modules to allow not only "source
# filename", but "source -encoding E filename" as well.
@@ -840,7 +840,7 @@ proc ::safe::AliasSource {slave args} {
set encoding [lindex $args 1]
set at 2
if {$encoding eq "identity"} {
Log $slave "attempt to use the identity encoding"
Log $child "attempt to use the identity encoding"
return -code error "permission denied"
}
} else {
@@ -849,39 +849,39 @@ proc ::safe::AliasSource {slave args} {
}
if {$argc != 1} {
set msg "wrong # args: should be \"source ?-encoding E? fileName\""
Log $slave "$msg ($args)"
Log $child "$msg ($args)"
return -code error $msg
}
set file [lindex $args $at]
# get the real path from the virtual one.
if {[catch {
set realfile [TranslatePath $slave $file]
set realfile [TranslatePath $child $file]
} msg]} {
Log $slave $msg
Log $child $msg
return -code error "permission denied"
}
# check that the path is in the access path of that slave
# check that the path is in the access path of that child
if {[catch {
FileInAccessPath $slave $realfile
FileInAccessPath $child $realfile
} msg]} {
Log $slave $msg
Log $child $msg
return -code error "permission denied"
}
# do the checks on the filename :
if {[catch {
CheckFileName $slave $realfile
CheckFileName $child $realfile
} msg]} {
Log $slave "$realfile:$msg"
Log $child "$realfile:$msg"
return -code error $msg
}
# Passed all the tests, lets source it. Note that we do this all manually
# because we want to control [info script] in the slave so information
# because we want to control [info script] in the child so information
# doesn't leak so much. [Bug 2913625]
set old [::interp eval $slave {info script}]
set old [::interp eval $child {info script}]
set replacementMsg "script error"
set code [catch {
set f [open $realfile]
@@ -891,17 +891,17 @@ proc ::safe::AliasSource {slave args} {
}
set contents [read $f]
close $f
::interp eval $slave [list info script $file]
::interp eval $child [list info script $file]
} msg opt]
if {$code == 0} {
set code [catch {::interp eval $slave $contents} msg opt]
set code [catch {::interp eval $child $contents} msg opt]
set replacementMsg $msg
}
catch {interp eval $slave [list info script $old]}
catch {interp eval $child [list info script $old]}
# Note that all non-errors are fine result codes from [source], so we must
# take a little care to do it properly. [Bug 2923613]
if {$code == 1} {
Log $slave $msg
Log $child $msg
return -code error $replacementMsg
}
return -code $code -options $opt $msg
@@ -909,18 +909,18 @@ proc ::safe::AliasSource {slave args} {
# AliasLoad is the target of the "load" alias in safe interpreters.
proc ::safe::AliasLoad {slave file args} {
proc ::safe::AliasLoad {child file args} {
set argc [llength $args]
if {$argc > 2} {
set msg "load error: too many arguments"
Log $slave "$msg ($argc) {$file $args}"
Log $child "$msg ($argc) {$file $args}"
return -code error $msg
}
# package name (can be empty if file is not).
set package [lindex $args 0]
namespace upvar ::safe S$slave state
namespace upvar ::safe S$child state
# Determine where to load. load use a relative interp path and {}
# means self, so we can directly and safely use passed arg.
@@ -929,7 +929,7 @@ proc ::safe::AliasLoad {slave file args} {
# we will try to load into a sub sub interp; check that we want to
# authorize that.
if {!$state(nestedok)} {
Log $slave "loading to a sub interp (nestedok)\
Log $child "loading to a sub interp (nestedok)\
disabled (trying to load $package to $target)"
return -code error "permission denied (nested load)"
}
@@ -940,11 +940,11 @@ proc ::safe::AliasLoad {slave file args} {
# static package loading
if {$package eq ""} {
set msg "load error: empty filename and no package name"
Log $slave $msg
Log $child $msg
return -code error $msg
}
if {!$state(staticsok)} {
Log $slave "static packages loading disabled\
Log $child "static packages loading disabled\
(trying to load $package to $target)"
return -code error "permission denied (static package)"
}
@@ -953,36 +953,36 @@ proc ::safe::AliasLoad {slave file args} {
# get the real path from the virtual one.
try {
set file [TranslatePath $slave $file]
set file [TranslatePath $child $file]
} on error msg {
Log $slave $msg
Log $child $msg
return -code error "permission denied"
}
# check the translated path
try {
FileInAccessPath $slave $file
FileInAccessPath $child $file
} on error msg {
Log $slave $msg
Log $child $msg
return -code error "permission denied (path)"
}
}
try {
return [::interp invokehidden $slave load $file $package $target]
return [::interp invokehidden $child load $file $package $target]
} on error msg {
Log $slave $msg
Log $child $msg
return -code error $msg
}
}
# FileInAccessPath raises an error if the file is not found in the list of
# directories contained in the (master side recorded) slave's access path.
# directories contained in the (parent side recorded) child's access path.
# the security here relies on "file dirname" answering the proper
# result... needs checking ?
proc ::safe::FileInAccessPath {slave file} {
namespace upvar ::safe S$slave state
proc ::safe::FileInAccessPath {child file} {
namespace upvar ::safe S$child state
set access_path $state(access_path)
if {[file isdirectory $file]} {
@@ -994,14 +994,14 @@ proc ::safe::FileInAccessPath {slave file} {
# potential pathname anomalies.
set norm_parent [file normalize $parent]
namespace upvar ::safe S$slave state
namespace upvar ::safe S$child state
if {$norm_parent ni $state(access_path,norm)} {
return -code error "\"$file\": not in access_path"
}
}
proc ::safe::DirInAccessPath {slave dir} {
namespace upvar ::safe S$slave state
proc ::safe::DirInAccessPath {child dir} {
namespace upvar ::safe S$child state
set access_path $state(access_path)
if {[file isfile $dir]} {
@@ -1012,7 +1012,7 @@ proc ::safe::DirInAccessPath {slave dir} {
# potential pathname anomalies.
set norm_dir [file normalize $dir]
namespace upvar ::safe S$slave state
namespace upvar ::safe S$child state
if {$norm_dir ni $state(access_path,norm)} {
return -code error "\"$dir\": not in access_path"
}
@@ -1021,16 +1021,16 @@ proc ::safe::DirInAccessPath {slave dir} {
# This procedure is used to report an attempt to use an unsafe member of an
# ensemble command.
proc ::safe::BadSubcommand {slave command subcommand args} {
proc ::safe::BadSubcommand {child command subcommand args} {
set msg "not allowed to invoke subcommand $subcommand of $command"
Log $slave $msg
Log $child $msg
return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}
# AliasEncoding is the target of the "encoding" alias in safe interpreters.
proc ::safe::AliasEncoding {slave option args} {
# Note that [encoding dirs] is not supported in safe slaves at all
proc ::safe::AliasEncoding {child option args} {
# Note that [encoding dirs] is not supported in safe children at all
set subcommands {convertfrom convertto names system}
try {
set option [tcl::prefix match -error [list -level 1 -errorcode \
@@ -1041,15 +1041,15 @@ proc ::safe::AliasEncoding {slave option args} {
"wrong # args: should be \"encoding system\""
}
} on error {msg options} {
Log $slave $msg
Log $child $msg
return -options $options $msg
}
tailcall ::interp invokehidden $slave encoding $option {*}$args
tailcall ::interp invokehidden $child encoding $option {*}$args
}
# Various minor hiding of platform features. [Bug 2913625]
proc ::safe::AliasExeName {slave} {
proc ::safe::AliasExeName {child} {
return ""
}
@@ -1062,7 +1062,7 @@ proc ::safe::Setup {} {
# Share the descriptions
set temp [::tcl::OptKeyRegister {
{-accessPath -list {} "access path for the slave"}
{-accessPath -list {} "access path for the child"}
{-noStatics "prevent loading of statically linked pkgs"}
{-statics true "loading of statically linked pkgs"}
{-nestedLoadOk "allow nested loading"}
@@ -1070,18 +1070,18 @@ proc ::safe::Setup {} {
{-deleteHook -script {} "delete hook"}
}]
# create case (slave is optional)
# create case (child is optional)
::tcl::OptKeyRegister {
{?slave? -name {} "name of the slave (optional)"}
{?child? -name {} "name of the child (optional)"}
} ::safe::interpCreate
# adding the flags sub programs to the command program (relying on Opt's
# internal implementation details)
lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)
# init and configure (slave is needed)
# init and configure (child is needed)
::tcl::OptKeyRegister {
{slave -name {} "name of the slave"}
{child -name {} "name of the child"}
} ::safe::interpIC
# adding the flags sub programs to the command program (relying on Opt's
@@ -1111,20 +1111,20 @@ namespace eval ::safe {
# Log command, set via 'setLogCmd'. Logging is disabled when empty.
variable Log {}
# The package maintains a state array per slave interp under its
# The package maintains a state array per child interp under its
# control. The name of this array is S<interp-name>. This array is
# brought into scope where needed, using 'namespace upvar'. The S
# prefix is used to avoid that a slave interp called "Log" smashes
# prefix is used to avoid that a child interp called "Log" smashes
# the "Log" variable.
#
# The array's elements are:
#
# access_path : List of paths accessible to the slave.
# access_path : List of paths accessible to the child.
# access_path,norm : Ditto, in normalized form.
# access_path,slave : Ditto, as the path tokens as seen by the slave.
# access_path,child : Ditto, as the path tokens as seen by the child.
# access_path,map : dict ( token -> path )
# access_path,remap : dict ( path -> token )
# tm_path_slave : List of TM root directories, as tokens seen by the slave.
# tm_path_child : List of TM root directories, as tokens seen by the child.
# staticsok : Value of option -statics
# nestedok : Value of option -nested
# cleanupHook : Value of option -deleteHook
+3 -3
View File
@@ -359,9 +359,9 @@ test appendComp-7.9 {append var does not trigger read trace} -setup {
} -result {0}
test appendComp-8.1 {defer error to runtime} -setup {
interp create slave
interp create child
} -body {
slave eval {
child eval {
proc foo {} {
proc append args {}
append
@@ -369,7 +369,7 @@ test appendComp-8.1 {defer error to runtime} -setup {
foo
}
} -cleanup {
interp delete slave
interp delete child
} -result {}
# New tests for bug 3057639 to show off the more consistent behaviour of
+3 -3
View File
@@ -1003,13 +1003,13 @@ test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
} {global}
test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup {
interp create slave
interp alias {} foo slave return
interp create child
interp alias {} foo child return
} -body {
list [catch foo m] $m
} -cleanup {
unset -nocomplain m
interp delete slave
interp delete child
} -result {0 {}}
# Clean up after expand tests
+1 -1
View File
@@ -1638,7 +1638,7 @@ test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
lsort [safeInterp eval [list file channels]]
} [lsort [list stdout $newFileId]]
test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
# we can now write to $newFileId from slave
# we can now write to $newFileId from child
safeInterp eval [list puts $newFileId "hello"]
} {}
interp transfer {} $newFileId safeInterp
+3 -3
View File
@@ -353,9 +353,9 @@ test compExpr-7.1 {Memory Leak} -constraints memory -setup {
} -body {
set end [getbytes]
for {set i 0} {$i < 5} {incr i} {
interp create slave
slave eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
interp delete slave
interp create child
child eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
interp delete child
set tmp $end
set end [getbytes]
}
+8 -8
View File
@@ -771,25 +771,25 @@ test coroutine-8.0.1 {coro inject after error} -body {
lappend ::result [catch {demo} err] $err
} -result {inject-executed 1 test}
test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body {
interp create slave
slave eval {
interp create child
child eval {
coroutine demo apply {{} { while {1} yield }}
demo
tcl::unsupported::inject demo set ::result inject-executed
}
interp delete slave
interp delete child
} -result {}
test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body {
interp create slave
slave eval {
interp create child
child eval {
coroutine demo apply {{} { while {1} yield }}
demo
tcl::unsupported::inject demo set ::result inject-executed
}
slave eval demo
set result [slave eval {set ::result}]
child eval demo
set result [child eval {set ::result}]
interp delete slave
interp delete child
set result
} -result {inject-executed}
+2 -2
View File
@@ -324,11 +324,11 @@ test env-5.2 {corner cases - unset the env array} -setup {
} -result {0}
test env-5.3 {corner cases: unset the env in master should unset child} -setup {
test env-5.3 {corner cases: unset the env in parent should unset child} -setup {
setup1
interp create i
} -body {
# Variables deleted in a master interp should be deleted in child interp
# Variables deleted in a parent interp should be deleted in child interp
# too.
i eval {set env(THIS_SHOULD_EXIST) a}
set result [set env(THIS_SHOULD_EXIST)]
+50 -50
View File
@@ -657,56 +657,56 @@ test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -se
namespace delete foo
} -result {0 AHA!}
test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup {
interp create slave
interp create child
} -body {
set script { llength {} }
slave eval {proc llength args {return AHA!}}
child eval {proc llength args {return AHA!}}
set result {}
lappend result [if 1 $script]
lappend result [slave eval $script]
lappend result [child eval $script]
} -cleanup {
interp delete slave
interp delete child
} -result {0 AHA!}
test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body {
set script { llength {} }
interp create slave
interp create child
set result {}
lappend result [slave eval $script]
interp delete slave
interp create slave
lappend result [slave eval $script]
lappend result [child eval $script]
interp delete child
interp create child
lappend result [child eval $script]
} -cleanup {
catch {interp delete slave}
catch {interp delete child}
} -result {0 0}
test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
interp create slave
interp create child
} -constraints testexprlongobj -body {
set e { [llength {}]+1 }
set result {}
load {} Tcltest slave
interp alias {} e slave testexprlongobj
load {} Tcltest child
interp alias {} e child testexprlongobj
lappend result [e $e]
interp delete slave
interp create slave
load {} Tcltest slave
interp alias {} e slave testexprlongobj
interp delete child
interp create child
load {} Tcltest child
interp alias {} e child testexprlongobj
lappend result [e $e]
} -cleanup {
interp delete slave
interp delete child
} -result {{This is a result: 1} {This is a result: 1}}
test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
interp create slave
interp create child
} -body {
set e { [llength {}]+1 }
set result {}
interp alias {} e slave expr
interp alias {} e child expr
lappend result [e $e]
interp delete slave
interp create slave
interp alias {} e slave expr
interp delete child
interp create child
interp alias {} e child expr
lappend result [e $e]
} -cleanup {
interp delete slave
interp delete child
} -result {1 1}
test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
set e { [llength {}]+1 }
@@ -747,16 +747,16 @@ test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setu
namespace delete foo
} -result {1 2}
test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup {
interp create slave
interp create child
} -body {
set e { [llength {}]+1 }
interp alias {} e slave expr
slave eval {proc llength args {return 1}}
interp alias {} e child expr
child eval {proc llength args {return 1}}
set result {}
lappend result [expr $e]
lappend result [e $e]
} -cleanup {
interp delete slave
interp delete child
} -result {1 2}
test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body {
proc foo e {set v 0; expr $e}
@@ -982,8 +982,8 @@ test execute-8.5 {Bug 2038069} -setup {
"catch \[list error FOO\] m o"} -errorline 2}
test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup {
interp create slave
slave eval {
interp create child
child eval {
package require tcltest
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands
@@ -992,31 +992,31 @@ test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup
}
}
} -body {
slave eval {
child eval {
lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C;
}
slave eval {
child eval {
set i 0; while {[incr i] < 3} {
lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C;
}
}
slave eval {
child eval {
set i 0; while {[incr i] < 3} {
lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C;
}
}
slave eval {
child eval {
catch {
lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C;
}
}
slave eval {set res}
child eval {set res}
} -cleanup {
interp delete slave
interp delete child
} -result [lrepeat 4 A B]
test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup {
interp create slave
slave eval {
interp create child
child eval {
package require tcltest
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands
@@ -1027,28 +1027,28 @@ test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), excepti
} -body {
set res {}
lappend res [catch {
slave eval {
child eval {
lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C;
}
} e] $e
lappend res [catch {
slave eval {
child eval {
lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C;
}
} e] $e
lappend res [catch {
slave eval {
child eval {
lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C;
}
} e] $e
lappend res [catch {
slave eval {
child eval {
lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C;
}
} e] $e
list $res [slave eval {set res}]
list $res [child eval {set res}]
} -cleanup {
interp delete slave
interp delete child
} -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]]
test execute-9.1 {Interp result resetting [Bug 1522803]} {
@@ -1069,16 +1069,16 @@ test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130
} {48 {304 304}}
test execute-10.2 {Bug 2802881} -setup {
interp create slave
interp create child
} -body {
# If [Bug 2802881] is not fixed, this will segfault
slave eval {
child eval {
trace add variable ::errorInfo write {expr {$foo} ;#}
proc demo {} {a {}{}}
demo
}
} -cleanup {
interp delete slave
interp delete child
} -returnCodes error -match glob -result *
test execute-10.3 {Bug 3072640} -setup {
proc generate {n} {
@@ -1103,9 +1103,9 @@ test execute-10.3 {Bug 3072640} -setup {
} -result 4
test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
interp create slave
interp create child
} -body {
slave eval {
child eval {
set x [lrepeat 1320 199]
for {set i 0} {$i < 20} {incr i} {
lappend x $i
@@ -1115,7 +1115,7 @@ test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
return ok
}
} -cleanup {
interp delete slave
interp delete child
} -result ok
test execute-11.2 {Bug 268b23df11} -setup {
+1 -1
View File
@@ -19,7 +19,7 @@ if {[catch {package require http 2} version]} {
catch {puts "Cannot load http 2.* package"}
return
} else {
catch {puts "Running http 2.* tests in slave interp"}
catch {puts "Running http 2.* tests in child interp"}
set interp [interp create http2]
$interp eval [list set http2 "running"]
$interp eval [list set argv $argv]
+1 -1
View File
@@ -22,7 +22,7 @@ if {[catch {package require http 1.0}]} {
::tcltest::cleanupTests
return
} else {
catch {puts "Running http 1.0 tests in slave interp"}
catch {puts "Running http 1.0 tests in child interp"}
set interp [interp create httpold]
$interp eval [list set httpold "running"]
$interp eval [list set argv $argv]
+247 -247
View File
File diff suppressed because it is too large Load Diff
+3 -3
View File
@@ -8660,16 +8660,16 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
set rfd [open $fn r]
testobj freeallvars
interp create slave
interp create child
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
read [teststringobj get 1]
testobj duplicate 1 2
interp transfer {} $rfd slave
interp transfer {} $rfd child
catch {read [teststringobj get 1]}
read [teststringobj get 2]
} -cleanup {
interp delete slave
interp delete child
testobj freeallvars
removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}
+5 -5
View File
@@ -2029,7 +2029,7 @@ test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
set ida [interp create];#puts <<$ida>>
set idb [interp create];#puts <<$idb>>
# Magic to get the test* commands in the slaves
# Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
@@ -2067,7 +2067,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
set ida [interp create];#puts <<$ida>>
set idb [interp create];#puts <<$idb>>
# Magic to get the test* commands in the slaves
# Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
@@ -2109,13 +2109,13 @@ test iocmd-32.2 {delete interp of reflected chan} {
# Bug 3034840
# Run this test in an interp with memory debugging to panic
# on the double free
interp create slave
slave eval {
interp create child
child eval {
proc no-op args {}
proc driver {sub args} {return {initialize finalize watch read}}
chan event [chan create read driver] readable no-op
}
interp delete slave
interp delete child
} {}
# ### ### ### ######### ######### #########
+10 -10
View File
@@ -1162,7 +1162,7 @@ test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
set ida [interp create]; #puts <<$ida>>
set idb [interp create]; #puts <<$idb>>
# Magic to get the test* commands in the slaves
# Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
@@ -1205,7 +1205,7 @@ test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
set ida [interp create]; #puts <<$ida>>
set idb [interp create]; #puts <<$idb>>
# Magic to get the test* commands in the slaves
# Magic to get the test* commands in the children
load {} Tcltest $ida
load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
@@ -1244,16 +1244,16 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces
tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
interp create slave
# Magic to get the test* commands into the slave
load {} Tcltest slave
interp create child
# Magic to get the test* commands into the child
load {} Tcltest child
} -constraints {testchannel} -body {
# Get base channel into the slave
# Get base channel into the child
set c [tempchan]
testchannel cut $c
interp eval slave [list testchannel splice $c]
interp eval slave [list set c $c]
slave eval {
interp eval child [list testchannel splice $c]
interp eval child [list set c $c]
child eval {
proc no-op args {}
proc driver {c sub args} {
return {initialize finalize read write}
@@ -1261,7 +1261,7 @@ test iortrans-11.2 {delete interp of reflected transform} -setup {
set t [chan push $c [list driver $c]]
chan event $c readable no-op
}
interp delete slave
interp delete child
} -cleanup {
tempdone
} -result {}
+1 -1
View File
@@ -103,7 +103,7 @@ test load-3.1 {error in _Init procedure, same interpreter} \
"if 44 {open non_existent}"
invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, slave interpreter} \
test load-3.2 {error in _Init procedure, child interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
+29 -29
View File
@@ -179,21 +179,21 @@ test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns}
namespace delete test_ns_2
} {}
test namespace-7.7 {Bug 1655305} -setup {
interp create slave
interp create child
# Can't invoke through the ensemble, since deleting the global namespace
# (indirectly, via deleting ::tcl) deletes the ensemble.
slave eval {rename ::tcl::info::commands ::infocommands}
slave hide infocommands
slave eval {
child eval {rename ::tcl::info::commands ::infocommands}
child hide infocommands
child eval {
proc foo {} {
namespace delete ::
}
}
} -body {
slave eval foo
slave invokehidden infocommands
child eval foo
child invokehidden infocommands
} -cleanup {
interp delete slave
interp delete child
} -result {}
test namespace-7.8 {Bug ba1419303b4c} -setup {
@@ -269,28 +269,28 @@ test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away}
[info commands test_ns_import::*]
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
interp create slave
slave eval {trace add execution error leave {namespace delete :: ;#}}
catch {slave eval error foo bar baz}
interp delete slave
interp create child
child eval {trace add execution error leave {namespace delete :: ;#}}
catch {child eval error foo bar baz}
interp delete child
set ::errorInfo
} {bar
invoked from within
"slave eval error foo bar baz"}
"child eval error foo bar baz"}
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
interp create slave
slave eval {trace add variable errorCode write {namespace delete :: ;#}}
catch {slave eval error foo bar baz}
interp delete slave
interp create child
child eval {trace add variable errorCode write {namespace delete :: ;#}}
catch {child eval error foo bar baz}
interp delete child
set ::errorInfo
} {bar
invoked from within
"slave eval error foo bar baz"}
"child eval error foo bar baz"}
test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
interp create slave
slave eval {trace add execution error leave {namespace delete :: ;#}}
catch {slave eval error foo bar baz}
interp delete slave
interp create child
child eval {trace add execution error leave {namespace delete :: ;#}}
catch {child eval error foo bar baz}
interp delete child
set ::errorCode
} baz
@@ -2797,9 +2797,9 @@ test namespace-51.15 {namespace resolution path control} -body {
namespace delete ::test_ns_2
}
test namespace-51.16 {Bug 1566526} {
interp create slave
slave eval namespace eval demo namespace path ::
interp delete slave
interp create child
child eval namespace eval demo namespace path ::
interp delete child
} {}
test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
set result {}
@@ -3000,19 +3000,19 @@ test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
}
}
catch {rename ::noSuchCommand {}}
set ::slave [interp create]
set ::child [interp create]
} -body {
$::slave alias bar noSuchCommand
$::child alias bar noSuchCommand
namespace eval test_ns_1 {
namespace unknown unknown
proc unknown args {
return FAIL
}
$::slave eval bar
$::child eval bar
}
} -cleanup {
interp delete $::slave
unset ::slave
interp delete $::child
unset ::child
namespace delete test_ns_1
rename ::unknown {}
rename unknown.save ::unknown
+77 -77
View File
@@ -306,19 +306,19 @@ test oo-1.18.2 {Bug 75b8433707: memory leak in oo-1.18} -setup {
rename test-oo-1.18 {}
} -result 0
test oo-1.18.3 {Bug 21c144f0f5} -setup {
interp create slave
interp create child
} -body {
slave eval {
child eval {
oo::define [oo::class create foo] superclass oo::class
oo::class destroy
}
} -cleanup {
interp delete slave
interp delete child
}
test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
interp create slave
interp create child
} -body {
slave eval {
child eval {
oo::class create A
oo::class create B {
superclass oo::class
@@ -330,12 +330,12 @@ test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
[B create C] create d
}
} -returnCodes error -cleanup {
interp delete slave
interp delete child
} -result {class should only be a direct superclass once}
test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
interp create slave
interp create child
} -body {
slave eval {
child eval {
oo::class create A
oo::class create B {
superclass oo::class
@@ -347,7 +347,7 @@ test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
[B create C {B C}] create d
}
} -returnCodes error -cleanup {
interp delete slave
interp delete child
} -result {attempt to form circular dependency graph}
test oo-1.19 {basic test of OO functionality: teardown order} -body {
oo::object create o
@@ -1370,16 +1370,16 @@ test oo-7.8 {OO: next at the end of the method chain} -setup {
} -result {foo2 foo 1 {no next method implementation}}
test oo-7.9 {OO: defining inheritance in namespaces} -setup {
set ::result {}
oo::class create ::master
oo::class create ::parent
namespace eval ::foo {
oo::class create mixin {superclass ::master}
oo::class create mixin {superclass ::parent}
}
} -cleanup {
::master destroy
::parent destroy
namespace delete ::foo
} -body {
namespace eval ::foo {
oo::class create bar {superclass master}
oo::class create bar {superclass parent}
oo::class create boo
oo::define boo {superclass bar}
oo::define boo {mixin mixin}
@@ -2066,18 +2066,18 @@ test oo-14.5 {OO and mixins and filters - advanced case} -setup {
mix destroy
} -result >>foobar<<
test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create A {
superclass master
superclass parent
method egg {} {
return chicken
}
}
oo::class create B {
superclass master
superclass parent
mixin A
method bar {} {
# mixin from A
@@ -2085,7 +2085,7 @@ test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
}
}
oo::class create C {
superclass master
superclass parent
mixin B
method foo {} {
# mixin from B
@@ -2095,12 +2095,12 @@ test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
[C new] foo
} -result chicken
test oo-14.7 {OO and filters from mixins of mixins} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create A {
superclass master
superclass parent
method egg {} {
return chicken
}
@@ -2111,7 +2111,7 @@ test oo-14.7 {OO and filters from mixins of mixins} -setup {
}
}
oo::class create B {
superclass master
superclass parent
mixin A
filter f
method bar {} {
@@ -2120,7 +2120,7 @@ test oo-14.7 {OO and filters from mixins of mixins} -setup {
}
}
oo::class create C {
superclass master
superclass parent
mixin B
filter f
method foo {} {
@@ -2132,18 +2132,18 @@ test oo-14.7 {OO and filters from mixins of mixins} -setup {
} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
test oo-14.8 {OO: class mixin order - Bug 1998221} -setup {
set ::result {}
oo::class create master {
oo::class create parent {
method test {} {}
}
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create mix {
superclass master
superclass parent
method test {} {lappend ::result mix; next; return $::result}
}
oo::class create cls {
superclass master
superclass parent
mixin mix
method test {} {lappend ::result cls; next; return $::result}
}
@@ -2778,13 +2778,13 @@ test oo-18.7 {OO: objdefine command support} -setup {
invoked from within
"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
test oo-18.8 {OO: define/self command support} -setup {
oo::class create master
oo::class create ::foo {superclass master}
oo::class create parent
oo::class create ::foo {superclass parent}
} -body {
catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
dict get $opt -errorinfo
} -cleanup {
master destroy
parent destroy
} -result {foobar
while executing
"error foobar"
@@ -2795,15 +2795,15 @@ test oo-18.8 {OO: define/self command support} -setup {
invoked from within
"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
test oo-18.9 {OO: define/self command support} -setup {
oo::class create master
oo::class create parent
set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
superclass master
superclass parent
}]
} -body {
catch {oo::define $c {error err}} msg opt
dict get $opt -errorinfo
} -cleanup {
master destroy
parent destroy
} -result {err
while executing
"error err"
@@ -2811,13 +2811,13 @@ test oo-18.9 {OO: define/self command support} -setup {
invoked from within
"oo::define $c {error err}"}
test oo-18.10 {OO: define/self command support} -setup {
oo::class create master
oo::class create ::foo {superclass master}
oo::class create parent
oo::class create ::foo {superclass parent}
} -body {
catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
dict get $opt -errorinfo
} -cleanup {
master destroy
parent destroy
} -result {foobar
while executing
"error foobar"
@@ -2828,13 +2828,13 @@ test oo-18.10 {OO: define/self command support} -setup {
invoked from within
"oo::define foo {self {rename ::foo {}; error foobar}}"}
test oo-18.11 {OO: define/self command support} -setup {
oo::class create master
oo::class create ::foo {superclass master}
oo::class create parent
oo::class create ::foo {superclass parent}
} -body {
catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
dict get $opt -errorinfo
} -cleanup {
master destroy
parent destroy
} -result {this command cannot be called when the object has been deleted
while executing
"self {error foobar}"
@@ -3457,12 +3457,12 @@ test oo-27.2 {variables declaration - object introspection} -setup {
info object variables foo
} -result {a b c}
test oo-27.3 {variables declaration - basic behaviour} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3472,13 +3472,13 @@ test oo-27.3 {variables declaration - basic behaviour} -setup {
bar y
} -result 3
test oo-27.4 {variables declaration - destructors too} -setup {
oo::class create master
oo::class create parent
set result bad!
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3503,12 +3503,12 @@ test oo-27.5 {variables declaration - object-bound variables} -setup {
foo y
} -result 2
test oo-27.6 {variables declaration - non-interference of levels} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3523,12 +3523,12 @@ test oo-27.6 {variables declaration - non-interference of levels} -setup {
list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
} -result {{3 2 y! {}} {x! y!} {x! y!}}
test oo-27.7 {variables declaration - one underlying variable space} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x!
constructor {} {set x! 1}
method y {} {incr x!}
@@ -3555,12 +3555,12 @@ test oo-27.9 {variables declaration - error cases - arrays} -body {
oo::define oo::object variable bad(var)
} -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element}
test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable clsvar
constructor {} {
set clsvar 0
@@ -3583,12 +3583,12 @@ test oo-27.10 {variables declaration - no instance var leaks with class resolver
list [inst1 value] [inst2 value]
} -result {3 2}
test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable clsvar
constructor {} {
set clsvar 0
@@ -3656,12 +3656,12 @@ test oo-27.13 {variables declaration: Bug 3185009: require refcount management}
foo destroy
} -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}}
test oo-27.14 {variables declaration - multiple use} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x
variable y
method boo {} {
@@ -3672,12 +3672,12 @@ test oo-27.14 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 2,2}
test oo-27.15 {variables declaration - multiple use} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable
variable x y
method boo {} {
@@ -3688,12 +3688,12 @@ test oo-27.15 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 2,2}
test oo-27.16 {variables declaration - multiple use} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x
variable -clear
variable y
@@ -3705,12 +3705,12 @@ test oo-27.16 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 1,2}
test oo-27.17 {variables declaration - multiple use} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x
variable -set y
method boo {} {
@@ -3721,12 +3721,12 @@ test oo-27.17 {variables declaration - multiple use} -setup {
list [bar boo] [bar boo]
} -result {1,1 1,2}
test oo-27.18 {variables declaration - multiple use} -setup {
oo::class create master
oo::class create parent
} -cleanup {
master destroy
parent destroy
} -body {
oo::class create foo {
superclass master
superclass parent
variable x
variable -? y
method boo {} {
@@ -3824,12 +3824,12 @@ test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
} -result {v t}
test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
oo::class create Super
oo::class create Master {
oo::class create Parent {
superclass Super
variable member1 member2
constructor {} {
set member1 master1
set member2 master2
set member1 parent1
set member2 parent2
}
method getChild {} {
Child new [self]
@@ -3850,10 +3850,10 @@ test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
method result {} {return $result}
}
} -body {
[[Master new] getChild] result
[[Parent new] getChild] result
} -cleanup {
Super destroy
} -result {master1 master2 master1 master2 master1 master2 master1 master2}
} -result {parent1 parent2 parent1 parent2 parent1 parent2 parent1 parent2}
# A feature that's not supported because the mechanism may change without
# warning, but is supposed to work...
+4 -4
View File
@@ -882,9 +882,9 @@ test oo-call-3.4 {current call introspection: in destructors} -setup {
# caller
set testopts {
-setup {
oo::class create Master
oo::class create Parent
oo::class create Foo {
superclass Master
superclass Parent
method bar {} {
puts abc
tailcall puts hi
@@ -892,11 +892,11 @@ set testopts {
}
}
oo::class create Foo2 {
superclass Master
superclass Parent
}
}
-cleanup {
Master destroy
Parent destroy
}
}
+9 -9
View File
@@ -405,14 +405,14 @@ test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv {
proc ::unknown args {lappend ::info [info level]; uplevel 1 foo}
proc ::foo args {lappend ::info global}
catch {rename ::noSuchCommand {}}
set ::slave [interp create]
$::slave alias bar noSuchCommand
set ::child [interp create]
$::child alias bar noSuchCommand
set ::info {}
namespace eval test_ns_1 {
proc foo args {lappend ::info namespace}
$::slave eval bar
testevalobjv 1 [list $::slave eval bar]
uplevel #0 [list $::slave eval bar]
$::child eval bar
testevalobjv 1 [list $::child eval bar]
uplevel #0 [list $::child eval bar]
}
namespace delete test_ns_1
rename ::foo {}
@@ -429,14 +429,14 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
lappend ::info ns
}]
catch {rename ::noSuchCommand {}}
set ::slave [interp create]
$::slave alias bar noSuchCommand
set ::child [interp create]
$::child alias bar noSuchCommand
set ::info {}
namespace eval test_ns_1 {
$::slave eval bar
$::child eval bar
}
namespace delete test_ns_1
interp delete $::slave
interp delete $::child
catch {rename ::noSuchCommand {}}
set ::info
} global
+11 -11
View File
@@ -72,11 +72,11 @@ proc pkgtest::parseArgs { args } {
# of the command line.
proc pkgtest::parseIndex { filePath } {
# create a slave interpreter, where we override "package ifneeded"
# create a child interpreter, where we override "package ifneeded"
set slave [interp create]
set child [interp create]
if {[catch {
$slave eval {
$child eval {
rename package package_original
proc package { args } {
if {[lindex $args 0] eq "ifneeded"} {
@@ -91,17 +91,17 @@ proc pkgtest::parseIndex { filePath } {
}
set dir [file dirname $filePath]
$slave eval {set curdir [pwd]}
$slave eval [list cd $dir]
$slave eval [list set dir $dir]
$slave eval [list source [file tail $filePath]]
$slave eval {cd $curdir}
$child eval {set curdir [pwd]}
$child eval [list cd $dir]
$child eval [list set dir $dir]
$child eval [list source [file tail $filePath]]
$child eval {cd $curdir}
# Create the list in sorted order, so that we don't get spurious
# errors because the order has changed.
array set P {}
foreach {k v} [$slave eval {array get ::PKGS}] {
foreach {k v} [$child eval {array get ::PKGS}] {
set P($k) $v
}
@@ -113,12 +113,12 @@ proc pkgtest::parseIndex { filePath } {
set ei [dict get $opts -errorinfo]
set ec [dict get $opts -errorcode]
catch {interp delete $slave}
catch {interp delete $child}
error $ei $ec
}
interp delete $slave
interp delete $child
return $PKGS
}
+3 -3
View File
@@ -389,9 +389,9 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {
test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
set lambda x
lappend lambda {set a 1}
interp create slave
slave eval [list apply $lambda foo]
interp delete slave
interp create child
child eval [list apply $lambda foo]
interp delete child
unset lambda
} {}
+1 -1
View File
@@ -203,7 +203,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
# resolver-agnostic).
#
# In order to make the test cases for the per-interpreter cmd literal pool
# reproducable and to minimize interactions between test cases, we use a slave
# reproducable and to minimize interactions between test cases, we use a child
# interpreter per test-case.
#
#
+14 -14
View File
@@ -17,7 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
foreach i [interp slaves] {
foreach i [interp children] {
interp delete $i
}
@@ -35,16 +35,16 @@ testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
safe::interpConfigure
} -result {no value given for parameter "slave" (use -help for full usage) :
slave name () name of the slave}
} -result {no value given for parameter "child" (use -help for full usage) :
child name () name of the child}
test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
safe::interpCreate -help
} -result {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
(-help gives this help)
?slave? name () name of the slave (optional)
-accessPath list () access path for the slave
?child? name () name of the child (optional)
-accessPath list () access path for the child
-noStatics boolflag (false) prevent loading of statically linked pkgs
-statics boolean (true) loading of statically linked pkgs
-nestedLoadOk boolflag (false) allow nested loading
@@ -53,7 +53,7 @@ test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
safe::interpInit -noStatics
} -result {bad value "-noStatics" for parameter
slave name () name of the slave}
child name () name of the child}
test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
# Disabled this test. It tests nothing sensible. [Bug 999612]
@@ -184,7 +184,7 @@ test safe-7.1 {tests that everything works at high level} -body {
set i [safe::interpCreate]
# no error shall occur:
# (because the default access_path shall include 1st level sub dirs so
# package require in a slave works like in the master)
# package require in a child works like in the parent)
set v [interp eval $i {package require http 2}]
# no error shall occur:
interp eval $i {http::config}
@@ -241,7 +241,7 @@ test safe-8.3 {safe source control on file} -setup {
safe::setLogCmd $prevlog
unset log
safe::interpDelete $i
} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
} -result {1 {permission denied} {{ERROR for child a : ".": is a directory}}}
test safe-8.4 {safe source control on file} -setup {
catch {safe::interpDelete $i}
set log {}
@@ -255,7 +255,7 @@ test safe-8.4 {safe source control on file} -setup {
safe::setLogCmd $prevlog
unset log
safe::interpDelete $i
} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
} -result {1 {permission denied} {{ERROR for child a : "/abc/def": not in access_path}}}
test safe-8.5 {safe source control on file} -setup {
catch {safe::interpDelete $i}
set log {}
@@ -273,7 +273,7 @@ test safe-8.5 {safe source control on file} -setup {
safe::setLogCmd $prevlog
unset log
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah]:no such file or directory"]]
test safe-8.6 {safe source control on file} -setup {
catch {safe::interpDelete $i}
set log {}
@@ -289,7 +289,7 @@ test safe-8.6 {safe source control on file} -setup {
safe::setLogCmd $prevlog
unset log
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah.tcl]:no such file or directory"]]
test safe-8.7 {safe source control on file} -setup {
catch {safe::interpDelete $i}
set log {}
@@ -307,7 +307,7 @@ test safe-8.7 {safe source control on file} -setup {
safe::setLogCmd $prevlog
unset log
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} emptyTest {
# Disabled this test. It was only useful for long unsupported
# Mac OS 9 systems. [Bug 860a9f1945]
@@ -375,7 +375,7 @@ test safe-9.2 {safe interps' error in deleteHook} -setup {
} -cleanup {
safe::setLogCmd $prevlog
unset log
} -result {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}}
} -result {{} {arg1 arg2 a} {{NOTICE for child a : About to delete} {ERROR for child a : Delete hook error (being catched)} {NOTICE for child a : Deleted}}}
test safe-9.3 {dual specification of statics} -returnCodes error -body {
safe::interpCreate -stat true -nostat
} -result {conflicting values given for -statics and -noStatics}
@@ -737,7 +737,7 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p
rename buildEnvironment {}
#### Test for the module path
test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
set tm {}
+15 -15
View File
@@ -1835,12 +1835,12 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
}
}
tcltest::DebugPuts 1 "== test \[$::localhost\]:$port $testmode =="
set ::master [thread::id]
# helper thread creating async connection and initiating transfer (detach) to master:
set ::parent [thread::id]
# helper thread creating async connection and initiating transfer (detach) to parent:
set ::helper [thread::create]
thread::send -async $::helper [list \
lassign [list $::master $::localhost $port $testmode] \
::master ::localhost ::port ::testmode
lassign [list $::parent $::localhost $port $testmode] \
::parent ::localhost ::port ::testmode
]
thread::send -async $::helper {
set ::helper [thread::id]
@@ -1849,29 +1849,29 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
if {"helper-writable" in $::testmode} {;# to test both sides during connect
fileevent $fd writable [list apply {{fd} {
if {[thread::id] ne $::helper} {
thread::send -async $::master {set ::count "ERROR: invalid thread, $::helper is expecting"}
thread::send -async $::parent {set ::count "ERROR: invalid thread, $::helper is expecting"}
close $fd
return
}
}} $fd]
};#
thread::detach $fd
thread::send -async $::master [list transf_master $fd {*}$args]
thread::send -async $::parent [list transf_parent $fd {*}$args]
}
iteration first
}
# master proc commiting transfer attempt (attach) and checking acquire was successful:
proc transf_master {fd args} {
# parent proc commiting transfer attempt (attach) and checking acquire was successful:
proc transf_parent {fd args} {
tcltest::DebugPuts 1 "** trma / $::count ** $args **"
thread::attach $fd
if {"master-close" in $::testmode} {;# to test close during connect
if {"parent-close" in $::testmode} {;# to test close during connect
set ::count $::count
close $fd
return
};#
fileevent $fd writable [list apply {{fd} {
if {[thread::id] ne $::master} {
thread::send -async $::master {set ::count "ERROR: invalid thread, $::master is expecting"}
if {[thread::id] ne $::parent} {
thread::send -async $::parent {set ::count "ERROR: invalid thread, $::parent is expecting"}
close $fd
return
}
@@ -1899,7 +1899,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
if {$srvsock ne {}} {close $srvsock}
if {[info exists ::helper]} {thread::release -wait $::helper}
tcltest::DebugPuts 1 "== stop / $::count =="
unset -nocomplain ::count ::testmode ::master ::helper
unset -nocomplain ::count ::testmode ::parent ::helper
}
}
test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body {
@@ -1909,12 +1909,12 @@ test socket_$af-13.2.tr2 {Testing socket transfer between threads during async c
transf_test {transfer helper-writable} 100
} -result 100 -constraints [list socket supported_$af thread]
test socket_$af-13.2.cl1 {Testing socket transfer between threads during async connect} -body {
transf_test {master-close} 100
transf_test {parent-close} 100
} -result 100 -constraints [list socket supported_$af thread]
test socket_$af-13.2.cl2 {Testing socket transfer between threads during async connect} -body {
transf_test {master-close helper-writable} 100
transf_test {parent-close helper-writable} 100
} -result 100 -constraints [list socket supported_$af thread]
catch {rename transf_master {}}
catch {rename transf_parent {}}
rename transf_test {}
# ----------------------------------------------------------------------
+7 -7
View File
@@ -282,18 +282,18 @@ test subst-13.1 {Bug 3081065} -setup {
demo name2
} subst13.tcl]
} -body {
interp create slave
slave eval [list source $script]
interp delete slave
interp create slave
slave eval {
interp create child
child eval [list source $script]
interp delete child
interp create child
child eval {
set count 400
while {[incr count -1]} {
lappend bloat [expr {rand()}]
}
}
slave eval [list source $script]
interp delete slave
child eval [list source $script]
interp delete child
} -cleanup {
removeFile subst13.tcl
}
+68 -68
View File
@@ -13,7 +13,7 @@
# testing to run the test itself. Ditto on things like [verbose].
#
# It would be better to have the -body of the tests run the tcltest
# commands in a slave interp so the [test] being tested would not
# commands in a child interp so the [test] being tested would not
# interfere with the [test] doing the testing.
#
@@ -63,11 +63,11 @@ test tcltest-1.3 {tcltest -h} {exec} {
} {1 0}
# -verbose, implicit & explicit testing of [verbose]
proc slave {msgVar args} {
proc child {msgVar args} {
upvar 1 $msgVar msg
interp create [namespace current]::i
# Fake the slave interp into dumping output to a file
# Fake the child interp into dumping output to a file
i eval {namespace eval ::tcltest {}}
i eval "set tcltest::outputChannel\
\[[list open [set of [makeFile {} output]] w]]"
@@ -99,44 +99,44 @@ proc slave {msgVar args} {
return $code
}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} {
set result [slave msg test.tcl]
set result [child msg test.tcl]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'b']
set result [child msg test.tcl -verbose 'b']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'p']
set result [child msg test.tcl -verbose 'p']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 0 1}
test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} {
set result [slave msg test.tcl -verbose 's']
set result [child msg test.tcl -verbose 's']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 0 1 1}
test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'ps']
set result [child msg test.tcl -verbose 'ps']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 1 1}
test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} {
set result [slave msg test.tcl -verbose 'psb']
set result [child msg test.tcl -verbose 'psb']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
set result [slave msg test.tcl -verbose "pass skip body"]
set result [child msg test.tcl -verbose "pass skip body"]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
@@ -145,7 +145,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
test tcltest-2.6 {tcltest -verbose 't'} {
-constraints {unixOrWin}
-body {
set result [slave msg test.tcl -verbose 't']
set result [child msg test.tcl -verbose 't']
list $result $msg
}
-result {^0 .*a-1.0 start.*b-1.0 start}
@@ -155,7 +155,7 @@ test tcltest-2.6 {tcltest -verbose 't'} {
test tcltest-2.6a {tcltest -verbose 'start'} {
-constraints {unixOrWin}
-body {
set result [slave msg test.tcl -verbose start]
set result [child msg test.tcl -verbose start]
list $result $msg
}
-result {^0 .*a-1.0 start.*b-1.0 start}
@@ -178,7 +178,7 @@ test tcltest-2.7 {tcltest::verbose} {
test tcltest-2.8 {tcltest -verbose 'error'} {
-constraints {unixOrWin}
-body {
set result [slave msg test.tcl -verbose error]
set result [child msg test.tcl -verbose error]
list $result $msg
}
-result {errorInfo: foo.*errorCode: 9}
@@ -186,22 +186,22 @@ test tcltest-2.8 {tcltest -verbose 'error'} {
}
# -match, [match]
test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} {
set result [slave msg test.tcl -match a* -verbose 'ps']
set result [child msg test.tcl -match a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} {
set result [slave msg test.tcl -match b* -verbose 'ps']
set result [child msg test.tcl -match b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} {
set result [slave msg test.tcl -match c* -verbose 'ps']
set result [child msg test.tcl -match c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} {
set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
set result [child msg test.tcl -match {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 1 0 1}
@@ -221,27 +221,27 @@ test tcltest-3.5 {tcltest::match} {
# -skip, [skip]
test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} {
set result [slave msg test.tcl -skip a* -verbose 'ps']
set result [child msg test.tcl -skip a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} {
set result [slave msg test.tcl -skip b* -verbose 'ps']
set result [child msg test.tcl -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} {
set result [slave msg test.tcl -skip c* -verbose 'ps']
set result [child msg test.tcl -skip c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} {
set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
set result [child msg test.tcl -skip {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} {
set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
set result [child msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
@@ -262,12 +262,12 @@ test tcltest-4.6 {tcltest::skip} {
# -constraints, -limitconstraints, [testConstraint],
# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} {
set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
set result [child msg test.tcl -constraints knownBug -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} {
set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
set result [child msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
[regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 0 0 1 1}
@@ -357,28 +357,28 @@ set printerror [makeFile {
test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
-constraints unixOrWin
-body {
slave msg $printerror
child msg $printerror
return $msg
}
-result {a test.*a really}
-match regexp
}
test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} {
slave msg $printerror -outfile a.tmp
child msg $printerror -outfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} {
slave msg $printerror -errfile a.tmp
child msg $printerror -errfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {1 0 1 0 1 {}}
test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} {
slave msg $printerror -outfile a.tmp -errfile b.tmp
child msg $printerror -outfile a.tmp -errfile b.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" b.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
@@ -463,7 +463,7 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} {
# -debug, [debug]
# Must use child processes to test -debug because it always writes
# messages to stdout, and we have no way to capture stdout of a
# slave interp
# child interp
test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} {
catch {exec [interpreter] test.tcl -debug 0} msg
regexp "Flags passed into tcltest" $msg
@@ -525,7 +525,7 @@ normalizePath normaldirectory
test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
file delete -force thisdirectorydoesnotexist
} -body {
slave msg $a -tmpdir thisdirectorydoesnotexist
child msg $a -tmpdir thisdirectorydoesnotexist
file exists [file join thisdirectorydoesnotexist a.tmp]
} -cleanup {
file delete -force thisdirectorydoesnotexist
@@ -533,7 +533,7 @@ test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
-constraints unixOrWin
-body {
slave msg $a -tmpdir $tdiaf
child msg $a -tmpdir $tdiaf
return $msg
}
-result {*not a directory*}
@@ -558,7 +558,7 @@ switch -- $::tcl_platform(platform) {
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
-constraints {unix notRoot}
-body {
slave msg $a -tmpdir $notReadableDir
child msg $a -tmpdir $notReadableDir
return $msg
}
-result {*not readable*}
@@ -574,7 +574,7 @@ testConstraint notFAT [expr {
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
-constraints {unixOrWin notRoot notFAT}
-body {
slave msg $a -tmpdir $notWriteableDir
child msg $a -tmpdir $notWriteableDir
return $msg
}
-result {*not writeable*}
@@ -583,7 +583,7 @@ test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
-constraints unixOrWin
-body {
slave msg $a -tmpdir $normaldirectory
child msg $a -tmpdir $normaldirectory
# The join is necessary because the message can be split on multiple
# lines
file exists [file join $normaldirectory a.tmp]
@@ -629,7 +629,7 @@ test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
file delete -force thisdirectorydoesnotexist
}
-body {
slave msg $a -testdir thisdirectorydoesnotexist
child msg $a -testdir thisdirectorydoesnotexist
return $msg
}
-match glob
@@ -638,7 +638,7 @@ test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
-constraints unixOrWin
-body {
slave msg $a -testdir $tdiaf
child msg $a -testdir $tdiaf
return $msg
}
-match glob
@@ -647,7 +647,7 @@ test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
-constraints {unix notRoot}
-body {
slave msg $a -testdir $notReadableDir
child msg $a -testdir $notReadableDir
return $msg
}
-match glob
@@ -656,7 +656,7 @@ test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
-constraints unixOrWin
-body {
slave msg $a -testdir $normaldirectory
child msg $a -testdir $normaldirectory
# The join is necessary because the message can be split on multiple
# lines
list [string first "testdir: $normaldirectory" [join $msg]] \
@@ -735,7 +735,7 @@ test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
set old [testsDirectory]
testsDirectory [file dirname [info script]]
} -body {
slave msg [file join [testsDirectory] all.tcl] -file d*.test
child msg [file join [testsDirectory] all.tcl] -file d*.test
return $msg
} -cleanup {
testsDirectory $old
@@ -745,7 +745,7 @@ test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup {
set old [testsDirectory]
testsDirectory [file dirname [info script]]
} -body {
slave msg [file join [testsDirectory] all.tcl] \
child msg [file join [testsDirectory] all.tcl] \
-file d*.test -notfile dstring*
regexp {dstring\.test} $msg
} -cleanup {
@@ -784,7 +784,7 @@ test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup {
makeFile {} fee $d
file copy [file join [file dirname [info script]] all.tcl] $d
} -body {
slave msg [file join [temporaryDirectory] all.tcl] -file f*
child msg [file join [temporaryDirectory] all.tcl] -file f*
regexp {exiting with errors:} $msg
} -cleanup {
file delete [file join $d all.tcl]
@@ -807,23 +807,23 @@ set mc [makeFile {
cd [temporaryDirectory]
test tcltest-10.1 {-preservecore 0} {unixOrWin} {
slave msg $mc -preservecore 0
child msg $mc -preservecore 0
file delete core
regexp "Core file produced" $msg
} {0}
test tcltest-10.2 {-preservecore 1} {unixOrWin} {
slave msg $mc -preservecore 1
child msg $mc -preservecore 1
file delete core
regexp "Core file produced" $msg
} {1}
test tcltest-10.3 {-preservecore 2} {unixOrWin} {
slave msg $mc -preservecore 2
child msg $mc -preservecore 2
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
test tcltest-10.4 {-preservecore 3} {unixOrWin} {
slave msg $mc -preservecore 3
child msg $mc -preservecore 3
file delete core
list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
@@ -854,7 +854,7 @@ set contents {
set loadfile [makeFile $contents load.tcl]
test tcltest-12.1 {-load xxx} {unixOrWin} {
slave msg $loadfile -load xxx
child msg $loadfile -load xxx
return $msg
} {xxx}
@@ -952,7 +952,7 @@ cd [workingDirectory]
test tcltest-14.1 {-singleproc - single process} {
-constraints {unixOrWin}
-body {
slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
child msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
return $msg
}
-result {Test file error: can't unset .foo.: no such variable}
@@ -962,7 +962,7 @@ test tcltest-14.1 {-singleproc - single process} {
test tcltest-14.2 {-singleproc - multiple process} {
-constraints {unixOrWin}
-body {
slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
child msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
return $msg
}
-result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
@@ -1026,7 +1026,7 @@ makeFile {
test tcltest-15.1 {basic directory walking} {
-constraints {unixOrWin}
-body {
if {[slave msg \
if {[child msg \
[file join $dtd all.tcl] \
-tmpdir [temporaryDirectory]] == 1} {
error $msg
@@ -1040,7 +1040,7 @@ test tcltest-15.1 {basic directory walking} {
test tcltest-15.2 {-asidefromdir} {
-constraints {unixOrWin}
-body {
if {[slave msg \
if {[child msg \
[file join $dtd all.tcl] \
-asidefromdir dirtestdir2.3 \
-tmpdir [temporaryDirectory]] == 1} {
@@ -1058,7 +1058,7 @@ Error: No test files remain after applying your match and skip patterns!$}
test tcltest-15.3 {-relateddir, non-existent dir} {
-constraints {unixOrWin}
-body {
if {[slave msg \
if {[child msg \
[file join $dtd all.tcl] \
-relateddir [file join [temporaryDirectory] dirtestdir0] \
-tmpdir [temporaryDirectory]] == 1} {
@@ -1073,7 +1073,7 @@ test tcltest-15.3 {-relateddir, non-existent dir} {
test tcltest-15.4 {-relateddir, subdir} {
-constraints {unixOrWin}
-body {
if {[slave msg \
if {[child msg \
[file join $dtd all.tcl] \
-relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
error $msg
@@ -1086,7 +1086,7 @@ test tcltest-15.4 {-relateddir, subdir} {
test tcltest-15.5 {-relateddir, -asidefromdir} {
-constraints {unixOrWin}
-body {
if {[slave msg \
if {[child msg \
[file join $dtd all.tcl] \
-relateddir "dirtestdir2.1 dirtestdir2.2" \
-asidefromdir dirtestdir2.2 \
@@ -1147,25 +1147,25 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
# set this to { } instead of just {} to get around quirk in
# Windows env handling that removes empty elements from env array.
set ::env(TCLTEST_OPTIONS) { }
interp create slave1
slave1 eval [list set argv {-debug 2}]
slave1 alias puts puts
interp create slave2
slave2 alias puts puts
interp create child1
child1 eval [list set argv {-debug 2}]
child1 alias puts puts
interp create child2
child2 alias puts puts
} -cleanup {
interp delete slave2
interp delete slave1
interp delete child2
interp delete child1
if {$oldoptions eq "none"} {
unset ::env(TCLTEST_OPTIONS)
} else {
set ::env(TCLTEST_OPTIONS) $oldoptions
}
} -body {
slave1 eval [package ifneeded tcltest [package provide tcltest]]
slave1 eval tcltest::debug
child1 eval [package ifneeded tcltest [package provide tcltest]]
child1 eval tcltest::debug
set ::env(TCLTEST_OPTIONS) "-debug 3"
slave2 eval [package ifneeded tcltest [package provide tcltest]]
slave2 eval tcltest::debug
child2 eval [package ifneeded tcltest [package provide tcltest]]
child2 eval tcltest::debug
} -result {^3$} -match regexp -output\
{tcltest::debug\s+= 2.*tcltest::debug\s+= 3}
@@ -1174,7 +1174,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
cd [temporaryDirectory]
# PrintError
test tcltest-20.1 {PrintError} {unixOrWin} {
set result [slave msg $printerror]
set result [child msg $printerror]
list $result [regexp "Error: a really short string" $msg] \
[regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \
[regexp " \"Really" $msg] [regexp Problem $msg]
@@ -1407,7 +1407,7 @@ makeFile {
} test.test $atd
# Must use a child process because stdout/stderr parsing can't be
# duplicated in slave interp.
# duplicated in child interp.
test tcltest-22.1 {runAllTests} {
-constraints {unixOrWin}
-body {
@@ -1806,7 +1806,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
tcltest::cleanupTests
} test.tcl
} -body {
slave msg [file join [temporaryDirectory] test.tcl]
child msg [file join [temporaryDirectory] test.tcl]
return $msg
} -cleanup {
removeFile test.tcl
@@ -1826,7 +1826,7 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
tcltest::cleanupTests
} test.tcl
} -body {
slave msg [file join [temporaryDirectory] test.tcl]
child msg [file join [temporaryDirectory] test.tcl]
return $msg
} -cleanup {
removeFile test.tcl
+2 -2
View File
@@ -802,7 +802,7 @@ test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -
} -cleanup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -setup {
test thread-7.22 {cancel: child interp} -constraints {thread drainEventQueue} -setup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
set serverthread [thread::create -joinable \
@@ -832,7 +832,7 @@ test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -s
} -cleanup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.23 {cancel: slave interp -unwind} -constraints {thread drainEventQueue} -setup {
test thread-7.23 {cancel: child interp -unwind} -constraints {thread drainEventQueue} -setup {
unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
set serverthread [thread::create -joinable \
+6 -6
View File
@@ -568,15 +568,15 @@ test timer-9.1 {AfterCleanupProc procedure} -setup {
} -result {before after2 after4}
test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
interp create slave
slave eval namespace export after
slave eval namespace eval foo namespace import ::after
interp create child
child eval namespace export after
child eval namespace eval foo namespace import ::after
} -body {
slave eval foo::after 1
slave eval namespace origin foo::after
child eval foo::after 1
child eval namespace origin foo::after
} -cleanup {
# Bug will cause crash here; would cause failure otherwise
interp delete slave
interp delete child
} -result ::after
test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} -body {
+5 -5
View File
@@ -2197,11 +2197,11 @@ foo {if {[catch {bar}]} {
}} 2 error leavestep
foo foo 0 error leave}}
test trace-28.4 {exec traces in slave with 'return -code error'} {
interp create slave
interp alias slave traceExecute {} traceExecute
test trace-28.4 {exec traces in child with 'return -code error'} {
interp create child
interp alias child traceExecute {} traceExecute
set info {}
set res [interp eval slave {
set res [interp eval child {
set info {}
set res {}
@@ -2229,7 +2229,7 @@ test trace-28.4 {exec traces in slave with 'return -code error'} {
list $res
}]
interp delete slave
interp delete child
lappend res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
+3 -3
View File
@@ -1046,15 +1046,15 @@ test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
lindex [split [memory info] \n] 3 3
}
proc doit {} {
interp create slave
slave eval {
interp create child
child eval {
proc doit script {
eval $script
set foo bar
}
doit {foreach foo baz {}}
}
interp delete slave
interp delete child
}
} -constraints memory -body {
set end [getbytes]
+89 -89
View File
@@ -279,19 +279,19 @@ test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio}
# -------------------------------------------------------------------------
test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup {
interp create slave
test winDde-7.1 {Load DDE in child interpreter} -constraints dde -setup {
interp create child
} -body {
slave eval [list load $::ddelib Dde]
slave eval [list dde servername -- dde-interp-7.1]
child eval [list load $::ddelib Dde]
child eval [list dde servername -- dde-interp-7.1]
} -cleanup {
interp delete slave
interp delete child
} -result {dde-interp-7.1}
test winDde-7.2 {DDE slave cleanup} -constraints dde -setup {
interp create slave
slave eval [list load $::ddelib Dde]
slave eval [list dde servername -- dde-interp-7.5]
interp delete slave
test winDde-7.2 {DDE child cleanup} -constraints dde -setup {
interp create child
child eval [list load $::ddelib Dde]
child eval [list dde servername -- dde-interp-7.5]
interp delete child
} -body {
dde services TclEval {}
set s [dde services TclEval {}]
@@ -300,128 +300,128 @@ test winDde-7.2 {DDE slave cleanup} -constraints dde -setup {
set s
}
} -result {}
test winDde-7.3 {DDE present in slave interp} -constraints dde -setup {
interp create slave
slave eval [list load $::ddelib Dde]
slave eval [list dde servername -- dde-interp-7.3]
test winDde-7.3 {DDE present in child interp} -constraints dde -setup {
interp create child
child eval [list load $::ddelib Dde]
child eval [list dde servername -- dde-interp-7.3]
} -body {
dde services TclEval dde-interp-7.3
} -cleanup {
interp delete slave
interp delete child
} -result {{TclEval dde-interp-7.3}}
test winDde-7.4 {interp name collision with -force} -constraints dde -setup {
interp create slave
slave eval [list load $::ddelib Dde]
slave eval [list dde servername -- dde-interp-7.4]
interp create child
child eval [list load $::ddelib Dde]
child eval [list dde servername -- dde-interp-7.4]
} -body {
dde servername -force -- dde-interp-7.4
} -cleanup {
interp delete slave
interp delete child
} -result {dde-interp-7.4}
test winDde-7.5 {interp name collision without -force} -constraints dde -setup {
interp create slave
slave eval [list load $::ddelib Dde]
slave eval [list dde servername -- dde-interp-7.5]
interp create child
child eval [list load $::ddelib Dde]
child eval [list dde servername -- dde-interp-7.5]
} -body {
dde servername -- dde-interp-7.5
} -cleanup {
interp delete slave
interp delete child
} -result "dde-interp-7.5 #2"
# -------------------------------------------------------------------------
test winDde-8.1 {Safe DDE load} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
interp create -safe child
child invokehidden load $::ddelib Dde
} -body {
slave eval dde servername slave
child eval dde servername child
} -cleanup {
interp delete slave
interp delete child
} -returnCodes error -result {invalid command name "dde"}
test winDde-8.2 {Safe DDE set servername} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
interp create -safe child
child invokehidden load $::ddelib Dde
} -body {
slave invokehidden dde servername slave
} -cleanup {interp delete slave} -result {slave}
child invokehidden dde servername child
} -cleanup {interp delete child} -result {child}
test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave invokehidden dde servername slave
interp create -safe child
child invokehidden load $::ddelib Dde
child invokehidden dde servername child
} -body {
catch {dde eval slave set a 1} msg
} -cleanup {interp delete slave} -result {1}
catch {dde eval child set a 1} msg
} -cleanup {interp delete child} -result {1}
test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave invokehidden dde servername slave
interp create -safe child
child invokehidden load $::ddelib Dde
child invokehidden dde servername child
} -body {
slave eval set a 1
dde execute TclEval slave {set a 2}
slave eval set a
} -cleanup {interp delete slave} -result 1
child eval set a 1
dde execute TclEval child {set a 2}
child eval set a
} -cleanup {interp delete child} -result 1
test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave invokehidden dde servername slave
interp create -safe child
child invokehidden load $::ddelib Dde
child invokehidden dde servername child
} -body {
slave eval set a 1
dde request TclEval slave a
child eval set a 1
dde request TclEval child a
} -cleanup {
interp delete slave
interp delete child
} -returnCodes error -result {remote server cannot handle this command}
test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
interp create -safe child
child invokehidden load $::ddelib Dde
child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
} -body {
slave invokehidden dde servername -handler DDEACCEPT slave
} -cleanup {interp delete slave} -result slave
child invokehidden dde servername -handler DDEACCEPT child
} -cleanup {interp delete child} -result child
test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
slave invokehidden dde servername -handler DDEACCEPT slave
interp create -safe child
child invokehidden load $::ddelib Dde
child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
child invokehidden dde servername -handler DDEACCEPT child
} -body {
dde eval slave set x 1
} -cleanup {interp delete slave} -result {set x 1}
dde eval child set x 1
} -cleanup {interp delete child} -result {set x 1}
test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
slave invokehidden dde servername -handler DDEACCEPT slave
interp create -safe child
child invokehidden load $::ddelib Dde
child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
child invokehidden dde servername -handler DDEACCEPT child
} -body {
set s "c:\\Program Files\\Microsoft Visual Studio\\"
dde eval slave $s
string equal [slave eval set DDECMD] $s
} -cleanup {interp delete slave} -result 1
dde eval child $s
string equal [child eval set DDECMD] $s
} -cleanup {interp delete child} -result 1
test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
slave invokehidden dde servername -handler DDEACCEPT slave
interp create -safe child
child invokehidden load $::ddelib Dde
child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
child invokehidden dde servername -handler DDEACCEPT child
} -body {
dde eval slave set \xe1 1
slave eval set \xe1
} -cleanup {interp delete slave} -result 1
dde eval child set \xe1 1
child eval set \xe1
} -cleanup {interp delete child} -result 1
test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
slave invokehidden dde servername -handler DDEACCEPT slave
interp create -safe child
child invokehidden load $::ddelib Dde
child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
child invokehidden dde servername -handler DDEACCEPT child
} -body {
dde eval slave [list set x 1]
slave eval set x
} -cleanup {interp delete slave} -result 1
dde eval child [list set x 1]
child eval set x
} -cleanup {interp delete child} -result 1
test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup {
interp create -safe slave
slave invokehidden load $::ddelib Dde
slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
slave invokehidden dde servername -handler DDEACCEPT slave
interp create -safe child
child invokehidden load $::ddelib Dde
child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
child invokehidden dde servername -handler DDEACCEPT child
} -body {
dde eval slave [list [list set x 1]]
slave eval set x
} -cleanup {interp delete slave} -returnCodes error -result {invalid command name "set x 1"}
dde eval child [list [list set x 1]]
child eval set x
} -cleanup {interp delete child} -returnCodes error -result {invalid command name "set x 1"}
# -------------------------------------------------------------------------
@@ -481,7 +481,7 @@ test winDde-9.4 {External safe DDE check null data passing} -constraints {dde st
# -------------------------------------------------------------------------
#cleanup
#catch {interp delete $slave}; # ensure we clean up the slave.
#catch {interp delete $child}; # ensure we clean up the child.
file delete -force $::scriptName
::tcltest::cleanupTests
return
+1 -1
View File
@@ -2027,7 +2027,7 @@ rpm: all
rm -rf RPMS THIS.TCL.SPEC
#
# Target to create a proper Tcl distribution from information in the master
# Target to create a proper Tcl distribution from information in the main
# source directory. DISTDIR must be defined to indicate where to put the
# distribution. DISTDIR must be an absolute path name.
#
+3 -3
View File
@@ -514,7 +514,7 @@ CFG_ENCODING = \"cp1252\"
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is
# in its own source. This is the "master" copy and kept updated.
# in its own source. This is the "main" copy and kept updated.
#
# Extensions built against an installed Tcl will use the installed
# copy of Tcl's nmakehlp.c if there is one and their own version
@@ -1669,7 +1669,7 @@ default-shell: default-setup $(PROJECT)
!ifdef RCFILE
# Note: don't use $** in below rule because there may be other dependencies
# and only the "master" rc must be passed to the resource compiler
# and only the "main" rc must be passed to the resource compiler
$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
$(RESCMD) $(RCDIR)\$(PROJECT).rc
@@ -1723,7 +1723,7 @@ DISABLE_IMPLICIT_RULES = 0
!if !$(DISABLE_IMPLICIT_RULES)
# Implicit rule definitions - only for building library objects. For stubs and
# main application, the master makefile should define explicit rules.
# main application, the main makefile should define explicit rules.
{$(ROOT)}.c{$(TMP_DIR)}.obj::
$(CCPKGCMD) @<<