Compare commits
52
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f52f05c3b1 | ||
|
|
03bdf41de2 | ||
|
|
206428d2cf | ||
|
|
bc0d613154 | ||
|
|
1d6f003314 | ||
|
|
e81a4abd60 | ||
|
|
06ebe62a5e | ||
|
|
0d78d389e1 | ||
|
|
eea64f8d90 | ||
|
|
4c5cc88bdf | ||
|
|
a1cee7cd20 | ||
|
|
3327979282 | ||
|
|
8c19725a30 | ||
|
|
0a224ddfc8 | ||
|
|
9a7c011683 | ||
|
|
44427fccaa | ||
|
|
c4cf77f310 | ||
|
|
9b00a63b22 | ||
|
|
91d9bd02c0 | ||
|
|
56b69c4e9a | ||
|
|
d2b1e66352 | ||
|
|
d29d888dc6 | ||
|
|
f4ed4079b7 | ||
|
|
dde5a2565e | ||
|
|
e59a1e0b14 | ||
|
|
c4b5bfbd50 | ||
|
|
44869c9e35 | ||
|
|
e5463e8ec8 | ||
|
|
bddf737714 | ||
|
|
ef0fd808de | ||
|
|
f4fb1d1752 | ||
|
|
59ea8cb145 | ||
|
|
e9cf99c212 | ||
|
|
80630f4ec9 | ||
|
|
e63dcc2677 | ||
|
|
9bbc90b227 | ||
|
|
8e5dbc8a27 | ||
|
|
29c6b72a83 | ||
|
|
fd5b3bb085 | ||
|
|
2fda7e49a0 | ||
|
|
27256fcd71 | ||
|
|
e702454abe | ||
|
|
9423df2491 | ||
|
|
05b1764f74 | ||
|
|
bff7817ec0 | ||
|
|
b339d4bf03 | ||
|
|
1e58e8e42d | ||
|
|
91af7f6f90 | ||
|
|
68191ded75 | ||
|
|
ac3d0b69d3 | ||
|
|
96f611f896 | ||
|
|
ec9c29c80d |
@@ -1,5 +1,5 @@
|
||||
README: Tcl
|
||||
This is the Tcl 8.6b3 source distribution.
|
||||
This is the Tcl 9.0a0 source distribution.
|
||||
http://tcl.sourceforge.net/
|
||||
You can get any source release of Tcl from the file distributions
|
||||
link at the above URL.
|
||||
|
||||
+1
-2
@@ -30,8 +30,7 @@ or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR
|
||||
return with an appropriate message. The particular script
|
||||
evaluation procedures of Tcl that act in the manner are
|
||||
\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
|
||||
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
|
||||
\fBTcl_VarEvalVA\fR.
|
||||
\fBTcl_VarEval\fR and \fBTcl_VarEvalVA\fR.
|
||||
.PP
|
||||
However, if \fBTcl_AllowExceptions\fR is invoked immediately before
|
||||
calling one of those a procedures, then arbitrary completion
|
||||
|
||||
@@ -1,47 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1989-1993 The Regents of the University of California.
|
||||
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.so man.macros
|
||||
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_Backslash \- parse a backslash sequence
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
.sp
|
||||
char
|
||||
\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS char *countPtr out
|
||||
.AP char *src in
|
||||
Pointer to a string starting with a backslash.
|
||||
.AP int *countPtr out
|
||||
If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled
|
||||
in with number of characters in the backslash sequence, including
|
||||
the backslash character.
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The use of \fBTcl_Backslash\fR is deprecated in favor of
|
||||
\fBTcl_UtfBackslash\fR.
|
||||
.PP
|
||||
This is a utility procedure provided for backwards compatibility with
|
||||
non-internationalized Tcl extensions. It parses a backslash sequence and
|
||||
returns the low byte of the Unicode character corresponding to the sequence.
|
||||
\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
|
||||
characters in the backslash sequence.
|
||||
.PP
|
||||
See the Tcl manual entry for information on the valid backslash sequences.
|
||||
All of the sequences described in the Tcl manual entry are supported by
|
||||
\fBTcl_Backslash\fR.
|
||||
.SH "SEE ALSO"
|
||||
Tcl(n), Tcl_UtfBackslash(3)
|
||||
|
||||
.SH KEYWORDS
|
||||
backslash, parse
|
||||
+19
-20
@@ -107,31 +107,30 @@ uses.
|
||||
\fBInterpreter Creation And Deletion\fR
|
||||
.
|
||||
When a new interpreter is created and used in a call to \fBTcl_Eval\fR,
|
||||
\fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or
|
||||
\fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and
|
||||
\fBTcl_Release\fR should be wrapped around all uses of the interpreter.
|
||||
Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR
|
||||
has been called. To ensure that the interpreter is properly deleted when
|
||||
it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other
|
||||
code already called \fBTcl_DeleteInterp\fR; if not, call
|
||||
\fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code.
|
||||
\fBTcl_VarEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of calls
|
||||
to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all
|
||||
uses of the interpreter. Remember that it is unsafe to use the interpreter
|
||||
once \fBTcl_Release\fR has been called. To ensure that the interpreter is
|
||||
properly deleted when it is no longer needed, call \fBTcl_InterpDeleted\fR
|
||||
to test if some other code already called \fBTcl_DeleteInterp\fR; if not,
|
||||
call \fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own
|
||||
code.
|
||||
.TP
|
||||
\fBRetrieving An Interpreter From A Data Structure\fR
|
||||
.
|
||||
When an interpreter is retrieved from a data structure (e.g. the client
|
||||
data of a callback) for use in one of the evaluation functions
|
||||
(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_EvalObjv\fR,
|
||||
etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR,
|
||||
\fBTcl_SetVar2Ex\fR, etc.), a pair of
|
||||
calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around
|
||||
all uses of the interpreter; it is unsafe to reuse the interpreter once
|
||||
\fBTcl_Release\fR has been called. If an interpreter is stored inside a
|
||||
callback data structure, an appropriate deletion cleanup mechanism should
|
||||
be set up by the code that creates the data structure so that the
|
||||
interpreter is removed from the data structure (e.g. by setting the field
|
||||
to NULL) when the interpreter is deleted. Otherwise, you may be using an
|
||||
interpreter that has been freed and whose memory may already have been
|
||||
reused.
|
||||
(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_EvalObjv\fR etc.) or variable
|
||||
access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, \fBTcl_SetVar2Ex\fR,
|
||||
etc.), a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should
|
||||
be wrapped around all uses of the interpreter; it is unsafe to reuse the
|
||||
interpreter once \fBTcl_Release\fR has been called. If an interpreter is
|
||||
stored inside a callback data structure, an appropriate deletion cleanup
|
||||
mechanism should be set up by the code that creates the data structure so
|
||||
that the interpreter is removed from the data structure (e.g. by setting
|
||||
the field to NULL) when the interpreter is deleted. Otherwise, you may be
|
||||
using an interpreter that has been freed and whose memory may already have
|
||||
been reused.
|
||||
.PP
|
||||
All uses of interpreters in Tcl and Tk have already been protected.
|
||||
Extension writers should ensure that their code also properly protects any
|
||||
|
||||
@@ -1,162 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1989-1993 The Regents of the University of California.
|
||||
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.so man.macros
|
||||
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
|
||||
.SH "NOTICE OF EVENTUAL DEPRECATION"
|
||||
.PP
|
||||
The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions
|
||||
are rendered somewhat obsolete by the ability to create functions for
|
||||
expressions by placing commands in the \fBtcl::mathfunc\fR namespace,
|
||||
as described in the \fBmathfunc\fR manual page; the API described on
|
||||
this page is not expected to be maintained indefinitely.
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
.sp
|
||||
void
|
||||
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr,
|
||||
clientDataPtr\fR)
|
||||
.sp
|
||||
Tcl_Obj *
|
||||
\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_ValueType *clientDataPtr out
|
||||
.AP Tcl_Interp *interp in
|
||||
Interpreter in which new function will be defined.
|
||||
.AP "const char" *name in
|
||||
Name for new function.
|
||||
.AP int numArgs in
|
||||
Number of arguments to new function; also gives size of \fIargTypes\fR array.
|
||||
.AP Tcl_ValueType *argTypes in
|
||||
Points to an array giving the permissible types for each argument to
|
||||
function.
|
||||
.AP Tcl_MathProc *proc in
|
||||
Procedure that implements the function.
|
||||
.AP ClientData clientData in
|
||||
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
|
||||
.AP int *numArgsPtr out
|
||||
Points to a variable that will be set to contain the number of
|
||||
arguments to the function.
|
||||
.AP Tcl_ValueType **argTypesPtr out
|
||||
Points to a variable that will be set to contain a pointer to an array
|
||||
giving the permissible types for each argument to the function which
|
||||
will need to be freed up using \fITcl_Free\fR.
|
||||
.AP Tcl_MathProc **procPtr out
|
||||
Points to a variable that will be set to contain a pointer to the
|
||||
implementation code for the function (or NULL if the function is
|
||||
implemented directly in bytecode).
|
||||
.AP ClientData *clientDataPtr out
|
||||
Points to a variable that will be set to contain the clientData
|
||||
argument passed to \fITcl_CreateMathFunc\fR when the function was
|
||||
created if the function is not implemented directly in bytecode.
|
||||
.AP "const char" *pattern in
|
||||
Pattern to match against function names so as to filter them (by
|
||||
passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Tcl allows a number of mathematical functions to be used in
|
||||
expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
|
||||
These functions are represented by commands in the namespace,
|
||||
\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is
|
||||
an obsolete way for applications to add additional functions
|
||||
to those already provided by Tcl or to replace existing functions.
|
||||
It should not be used by new applications, which should create
|
||||
math functions using \fBTcl_CreateObjCommand\fR to create a command
|
||||
in the \fBtcl::mathfunc\fR namespace.
|
||||
.PP
|
||||
In the \fBTcl_CreateMathFunc\fR interface,
|
||||
\fIName\fR is the name of the function as it will appear in expressions.
|
||||
If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR
|
||||
namespace, then a new command is created in that namespace.
|
||||
If \fIname\fR does exist, then the existing function is replaced.
|
||||
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
|
||||
Each entry in the \fIargTypes\fR array must be
|
||||
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR,
|
||||
or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an
|
||||
integer, a double-precision floating value, a wide (64-bit) integer,
|
||||
or any, respectively.
|
||||
.PP
|
||||
Whenever the function is invoked in an expression Tcl will invoke
|
||||
\fIproc\fR. \fIProc\fR should have arguments and result that match
|
||||
the type \fBTcl_MathProc\fR:
|
||||
.PP
|
||||
.CS
|
||||
typedef int \fBTcl_MathProc\fR(
|
||||
ClientData \fIclientData\fR,
|
||||
Tcl_Interp *\fIinterp\fR,
|
||||
Tcl_Value *\fIargs\fR,
|
||||
Tcl_Value *\fIresultPtr\fR);
|
||||
.CE
|
||||
.PP
|
||||
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
|
||||
arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
|
||||
\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
|
||||
which describe the actual arguments to the function:
|
||||
.PP
|
||||
.CS
|
||||
typedef struct Tcl_Value {
|
||||
Tcl_ValueType \fItype\fR;
|
||||
long \fIintValue\fR;
|
||||
double \fIdoubleValue\fR;
|
||||
Tcl_WideInt \fIwideValue\fR;
|
||||
} \fBTcl_Value\fR;
|
||||
.CE
|
||||
.PP
|
||||
The \fItype\fR field indicates the type of the argument and is
|
||||
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR.
|
||||
It will match the \fIargTypes\fR value specified for the function unless
|
||||
the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts
|
||||
the argument supplied in the expression to the type requested in
|
||||
\fIargTypes\fR, if that is necessary.
|
||||
Depending on the value of the \fItype\fR field, the \fIintValue\fR,
|
||||
\fIdoubleValue\fR or \fIwideValue\fR
|
||||
field will contain the actual value of the argument.
|
||||
.PP
|
||||
\fIProc\fR should compute its result and store it either as an integer
|
||||
in \fIresultPtr->intValue\fR or as a floating value in
|
||||
\fIresultPtr->doubleValue\fR.
|
||||
It should set also \fIresultPtr->type\fR to one of
|
||||
\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR
|
||||
to indicate which value was set.
|
||||
Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR.
|
||||
If an error occurs while executing the function, \fIproc\fR should
|
||||
return \fBTCL_ERROR\fR and leave an error message in the interpreter's result.
|
||||
.PP
|
||||
\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
|
||||
function \fIname\fR that were passed to a preceding
|
||||
\fBTcl_CreateMathFunc\fR call. Normally, the return code is
|
||||
\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
|
||||
is returned and an error message is placed in the interpreter's
|
||||
result.
|
||||
.PP
|
||||
If an error did not occur, the array reference placed in the variable
|
||||
pointed to by \fIargTypesPtr\fR is newly allocated, and should be
|
||||
released by passing it to \fBTcl_Free\fR. Some functions (the
|
||||
standard set implemented in the core, and those defined by placing
|
||||
commands in the \fBtcl::mathfunc\fR namespace) do not have
|
||||
argument type information; attempting to retrieve values for
|
||||
them causes a NULL to be stored in the variable pointed to by
|
||||
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
|
||||
will not be modified. The variable pointed to by \fInumArgsPointer\fR
|
||||
will contain -1, and no argument types will be stored in the variable
|
||||
pointed to by \fIargTypesPointer\fR.
|
||||
.PP
|
||||
\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all
|
||||
the math functions defined in the interpreter whose name matches
|
||||
\fIpattern\fR. The returned value has a reference count of zero.
|
||||
.SH "SEE ALSO"
|
||||
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)
|
||||
.SH KEYWORDS
|
||||
expression, mathematical function
|
||||
+1
-7
@@ -9,7 +9,7 @@
|
||||
.TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
|
||||
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -34,8 +34,6 @@ char *
|
||||
.sp
|
||||
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
|
||||
.sp
|
||||
\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
|
||||
.sp
|
||||
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
|
||||
.sp
|
||||
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
|
||||
@@ -128,10 +126,6 @@ caller to fill in the new space.
|
||||
even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
|
||||
will still need to be called.
|
||||
.PP
|
||||
\fBTcl_DStringTrunc\fR changes the length of a dynamic string.
|
||||
This procedure is now deprecated. \fBTcl_DStringSetLength\fR should
|
||||
be used instead.
|
||||
.PP
|
||||
\fBTcl_DStringFree\fR should be called when you are finished using
|
||||
the string. It frees up any memory that was allocated for the string
|
||||
and reinitializes the string's value to an empty string.
|
||||
|
||||
+4
-41
@@ -10,7 +10,7 @@
|
||||
.TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
|
||||
Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -19,9 +19,6 @@ int
|
||||
\fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_EvalFile\fR(\fIinterp, fileName\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR)
|
||||
.sp
|
||||
int
|
||||
@@ -31,12 +28,6 @@ int
|
||||
\fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GlobalEval\fR(\fIinterp, script\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR)
|
||||
.sp
|
||||
int
|
||||
@@ -93,22 +84,6 @@ integer value originating in an extension.
|
||||
In addition, a result value or error message is left in \fIinterp\fR's
|
||||
result; it can be retrieved using \fBTcl_GetObjResult\fR.
|
||||
.PP
|
||||
\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates
|
||||
its contents as a Tcl script. It returns the same information as
|
||||
\fBTcl_EvalObjEx\fR.
|
||||
If the file could not be read then a Tcl error is returned to describe
|
||||
why the file could not be read.
|
||||
The eofchar for files is
|
||||
.QW \e32
|
||||
(^Z) for all platforms. If you require a
|
||||
.QW ^Z
|
||||
in code for string comparison, you can use
|
||||
.QW \e032
|
||||
or
|
||||
.QW \eu001a ,
|
||||
which will be safely substituted by the Tcl interpreter into
|
||||
.QW ^Z .
|
||||
.PP
|
||||
\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
|
||||
script. The \fIobjc\fR and \fIobjv\fR arguments contain the values
|
||||
of the words for the Tcl command, one word in each value in
|
||||
@@ -128,23 +103,11 @@ might be a UTF-8 special code. The string is parsed and executed directly
|
||||
bytecodes. In situations where it is known that the script will never be
|
||||
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
|
||||
\fBTcl_Eval\fR returns a completion code and result just like
|
||||
\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before
|
||||
Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to
|
||||
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
|
||||
This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
|
||||
does not do the copy.
|
||||
\fBTcl_EvalObjEx\fR.
|
||||
.PP
|
||||
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
|
||||
additional arguments \fInumBytes\fR and \fIflags\fR. For the
|
||||
efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred
|
||||
over \fBTcl_Eval\fR.
|
||||
.PP
|
||||
\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures
|
||||
that are now deprecated. They are similar to \fBTcl_EvalEx\fR and
|
||||
\fBTcl_EvalObjEx\fR except that the script is evaluated in the global
|
||||
namespace and its variable context consists of global variables only
|
||||
(it ignores any Tcl procedures that are active). These functions are
|
||||
equivalent to using the \fBTCL_EVAL_GLOBAL\fR flag (see below).
|
||||
additional arguments \fInumBytes\fR and \fIflags\fR. \fBTcl_EvalEx\fR
|
||||
is generally preferred over \fBTcl_Eval\fR.
|
||||
.PP
|
||||
\fBTcl_VarEval\fR takes any number of string arguments
|
||||
of any length, concatenates them into a single string,
|
||||
|
||||
+8
-4
@@ -55,11 +55,15 @@ of integer digits, optionally signed and optionally preceded by
|
||||
white space. If the first two characters of \fIsrc\fR
|
||||
after the optional white space and sign are
|
||||
.QW 0x
|
||||
then \fIsrc\fR is expected to be in hexadecimal form; otherwise,
|
||||
if the first such character is
|
||||
.QW 0
|
||||
then \fIsrc\fR is expected to be in hexadecimal form.
|
||||
If the first two such characters are
|
||||
.QW 0o
|
||||
then \fIsrc\fR
|
||||
is expected to be in octal form; otherwise, \fIsrc\fR is
|
||||
is expected to be in octal form.
|
||||
If the first two such characters are
|
||||
.QW 0b
|
||||
then \fIsrc\fR
|
||||
is expected to be in binary form; otherwise, \fIsrc\fR is
|
||||
expected to be in decimal form.
|
||||
.PP
|
||||
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
|
||||
|
||||
+5
-19
@@ -8,7 +8,7 @@
|
||||
.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
|
||||
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -33,20 +33,16 @@ const char *
|
||||
.sp
|
||||
\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
|
||||
.sp
|
||||
Tcl_Obj *
|
||||
\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_Interp *usedParsePtr out
|
||||
.AP Tcl_Interp *interp out
|
||||
For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
|
||||
and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
|
||||
For procedures other than \fBTcl_FreeParse\fR and
|
||||
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
|
||||
if NULL, then no error messages are left after errors.
|
||||
For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
|
||||
determines the context for evaluating the
|
||||
script and also is used for error reporting; must not be NULL.
|
||||
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
|
||||
the script and also is used for error reporting; must not be NULL.
|
||||
.AP "const char" *start in
|
||||
Pointer to first character in string to parse.
|
||||
.AP int numBytes in
|
||||
@@ -191,16 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
|
||||
some other integer value originating in an extension.
|
||||
In addition, a result value or error message is left in \fIinterp\fR's
|
||||
result; it can be retrieved using \fBTcl_GetObjResult\fR.
|
||||
.PP
|
||||
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
|
||||
the return convention used: it returns the result in a new Tcl_Obj.
|
||||
The reference count of the value returned as result has been
|
||||
incremented, so the caller must
|
||||
invoke \fBTcl_DecrRefCount\fR when it is finished with the value.
|
||||
If an error or other exception occurs while evaluating the tokens
|
||||
(such as a reference to a non-existent variable) then the return value
|
||||
is NULL and an error message is left in \fIinterp\fR's result. The use
|
||||
of \fBTcl_EvalTokens\fR is deprecated.
|
||||
.SH "TCL_PARSE STRUCTURE"
|
||||
.PP
|
||||
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
|
||||
|
||||
+1
-3
@@ -31,9 +31,7 @@ the command at global level instead of the current stack level.
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
|
||||
on the history list and then execute it using \fBTcl_EvalObjEx\fR
|
||||
(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set
|
||||
in \fIflags\fR).
|
||||
on the history list and then execute it using \fBTcl_EvalObjEx\fR.
|
||||
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
|
||||
as well as a result value containing additional information
|
||||
(a result value or error message)
|
||||
|
||||
+1
-2
@@ -31,8 +31,7 @@ the command at global level instead of the current stack level.
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fBTcl_RecordAndEval\fR is invoked to record a command as an event
|
||||
on the history list and then execute it using \fBTcl_Eval\fR
|
||||
(or \fBTcl_GlobalEval\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set in \fIflags\fR).
|
||||
on the history list and then execute it using \fBTcl_Eval\fR.
|
||||
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_Eval\fR
|
||||
and it leaves information in the interpreter's result.
|
||||
If you do not want the command recorded on the history list then
|
||||
|
||||
+2
-2
@@ -29,8 +29,8 @@ New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
|
||||
.PP
|
||||
At any given time Tcl enforces a limit on the number of recursive
|
||||
calls that may be active for \fBTcl_Eval\fR and related procedures
|
||||
such as \fBTcl_GlobalEval\fR.
|
||||
Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with
|
||||
such as \fBTcl_EvalEx\fR.
|
||||
Any call to \fBTcl_EvalEx\fR that exceeds this depth is aborted with
|
||||
an error.
|
||||
By default the recursion limit is 1000.
|
||||
.PP
|
||||
|
||||
-60
@@ -1,60 +0,0 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1993 The Regents of the University of California.
|
||||
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.so man.macros
|
||||
.TH case n 7.0 Tcl "Tcl Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
case \- Evaluate one of several scripts, depending on a given value
|
||||
.SH SYNOPSIS
|
||||
\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...?
|
||||
.sp
|
||||
\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?}
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fINote: the \fBcase\fI command is obsolete and is supported only
|
||||
for backward compatibility. At some point in the future it may be
|
||||
removed entirely. You should use the \fBswitch\fI command instead.\fR
|
||||
.PP
|
||||
The \fBcase\fR command matches \fIstring\fR against each of
|
||||
the \fIpatList\fR arguments in order.
|
||||
Each \fIpatList\fR argument is a list of one or
|
||||
more patterns. If any of these patterns matches \fIstring\fR then
|
||||
\fBcase\fR evaluates the following \fIbody\fR argument
|
||||
by passing it recursively to the Tcl interpreter and returns the result
|
||||
of that evaluation.
|
||||
Each \fIpatList\fR argument consists of a single
|
||||
pattern or list of patterns. Each pattern may contain any of the wild-cards
|
||||
described under \fBstring match\fR. If a \fIpatList\fR
|
||||
argument is \fBdefault\fR, the corresponding body will be evaluated
|
||||
if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument
|
||||
matches \fIstring\fR and no default is given, then the \fBcase\fR
|
||||
command returns an empty string.
|
||||
.PP
|
||||
Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments.
|
||||
The first uses a separate argument for each of the patterns and commands;
|
||||
this form is convenient if substitutions are desired on some of the
|
||||
patterns or commands.
|
||||
The second form places all of the patterns and commands together into
|
||||
a single argument; the argument must have proper list structure, with
|
||||
the elements of the list being the patterns and commands.
|
||||
The second form makes it easy to construct multi-line case commands,
|
||||
since the braces around the whole list make it unnecessary to include a
|
||||
backslash at the end of each line.
|
||||
Since the \fIpatList\fR arguments are in braces in the second form,
|
||||
no command or variable substitutions are performed on them; this makes
|
||||
the behavior of the second form different than the first form in some
|
||||
cases.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
switch(n)
|
||||
|
||||
.SH KEYWORDS
|
||||
case, match, regular expression
|
||||
+1
-4
@@ -46,10 +46,7 @@ Where possible, operands are interpreted as integer values.
|
||||
Integer values may be specified in decimal (the normal case), in binary
|
||||
(if the first two characters of the operand are \fB0b\fR), in octal
|
||||
(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
|
||||
(if the first two characters of the operand are \fB0x\fR). For
|
||||
compatibility with older Tcl releases, an octal integer value is also
|
||||
indicated simply when the first character of the operand is \fB0\fR,
|
||||
whether or not the second character is also \fBo\fR.
|
||||
(if the first two characters of the operand are \fB0x\fR).
|
||||
If an operand does not have one of the integer formats given
|
||||
above, then it is treated as a floating-point number if that is
|
||||
possible. Floating-point numbers may be specified in any of several
|
||||
|
||||
+1
-1
@@ -357,7 +357,7 @@ namespace separator.
|
||||
\fBinfo script\fR ?\fIfilename\fR?
|
||||
.
|
||||
If a Tcl script file is currently being evaluated (i.e. there is a
|
||||
call to \fBTcl_EvalFile\fR active or there is an active invocation
|
||||
call to \fBTcl_FSEvalFile\fR active or there is an active invocation
|
||||
of the \fBsource\fR command), then this command returns the name
|
||||
of the innermost file being processed. If \fIfilename\fR is specified,
|
||||
then the return value of this command will be modified for the
|
||||
|
||||
+1
-4
@@ -106,10 +106,7 @@ of which work solely with floating-point numbers unless otherwise noted:
|
||||
In addition to these predefined functions, applications may
|
||||
define additional functions by using \fBproc\fR (or any other method,
|
||||
such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
|
||||
new commands in the \fBtcl::mathfunc\fR namespace. In addition, an
|
||||
obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
|
||||
extensions that are written in C. The latter interface is not recommended
|
||||
for new implementations.
|
||||
new commands in the \fBtcl::mathfunc\fR namespace.
|
||||
.SS "DETAILED DEFINITIONS"
|
||||
.TP
|
||||
\fBabs \fIarg\fR
|
||||
|
||||
+2
-4
@@ -226,12 +226,10 @@ set string "#08D03F"
|
||||
\fBscan\fR $string "#%2x%2x%2x" r g b
|
||||
.CE
|
||||
.PP
|
||||
Parse a \fIHH:MM\fR time string, noting that this avoids problems with
|
||||
octal numbers by forcing interpretation as decimals (if we did not
|
||||
care, we would use the \fB%i\fR conversion instead):
|
||||
Parse a \fIHH:MM\fR time string:
|
||||
.PP
|
||||
.CS
|
||||
set string "08:08" ;# *Not* octal!
|
||||
set string "08:08"
|
||||
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
|
||||
error "not a valid time string"
|
||||
}
|
||||
|
||||
@@ -63,9 +63,6 @@
|
||||
#ifdef __REG_VOID_T
|
||||
#undef __REG_VOID_T
|
||||
#endif
|
||||
#ifdef __REG_CONST
|
||||
#undef __REG_CONST
|
||||
#endif
|
||||
#ifdef __REG_NOFRONT
|
||||
#undef __REG_NOFRONT
|
||||
#endif
|
||||
@@ -76,7 +73,6 @@
|
||||
#define __REG_WIDE_T Tcl_UniChar
|
||||
#define __REG_REGOFF_T long /* Not really right, but good enough... */
|
||||
#define __REG_VOID_T void
|
||||
#define __REG_CONST const
|
||||
/* Names and declarations */
|
||||
#define __REG_WIDE_COMPILE TclReComp
|
||||
#define __REG_WIDE_EXEC TclReExec
|
||||
|
||||
+14
-28
@@ -95,9 +95,6 @@ extern "C" {
|
||||
#ifdef __REG_VOID_T
|
||||
#undef __REG_VOID_T
|
||||
#endif
|
||||
#ifdef __REG_CONST
|
||||
#undef __REG_CONST
|
||||
#endif
|
||||
#ifdef __REG_NOFRONT
|
||||
#undef __REG_NOFRONT
|
||||
#endif
|
||||
@@ -108,7 +105,6 @@ extern "C" {
|
||||
#define __REG_WIDE_T Tcl_UniChar
|
||||
#define __REG_REGOFF_T long /* not really right, but good enough... */
|
||||
#define __REG_VOID_T void
|
||||
#define __REG_CONST const
|
||||
/* names and declarations */
|
||||
#define __REG_WIDE_COMPILE TclReComp
|
||||
#define __REG_WIDE_EXEC TclReExec
|
||||
@@ -143,16 +139,6 @@ typedef __REG_VOID_T re_void;
|
||||
typedef void re_void;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Also for benefit of old compilers, <sys/types.h> can supply a macro which
|
||||
* expands to a substitute for `const'.
|
||||
*/
|
||||
#ifndef __REG_CONST
|
||||
#define __REG_CONST const
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* other interface types
|
||||
*/
|
||||
@@ -197,13 +183,13 @@ typedef struct {
|
||||
/*
|
||||
* compilation
|
||||
^ #ifndef __REG_NOCHAR
|
||||
^ int re_comp(regex_t *, __REG_CONST char *, size_t, int);
|
||||
^ int re_comp(regex_t *, const char *, size_t, int);
|
||||
^ #endif
|
||||
^ #ifndef __REG_NOFRONT
|
||||
^ int regcomp(regex_t *, __REG_CONST char *, int);
|
||||
^ int regcomp(regex_t *, const char *, int);
|
||||
^ #endif
|
||||
^ #ifdef __REG_WIDE_T
|
||||
^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
|
||||
^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
|
||||
^ #endif
|
||||
*/
|
||||
#define REG_BASIC 000000 /* BREs (convenience) */
|
||||
@@ -228,14 +214,14 @@ typedef struct {
|
||||
/*
|
||||
* execution
|
||||
^ #ifndef __REG_NOCHAR
|
||||
^ int re_exec(regex_t *, __REG_CONST char *, size_t,
|
||||
^ int re_exec(regex_t *, const char *, size_t,
|
||||
^ rm_detail_t *, size_t, regmatch_t [], int);
|
||||
^ #endif
|
||||
^ #ifndef __REG_NOFRONT
|
||||
^ int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
|
||||
^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
|
||||
^ #endif
|
||||
^ #ifdef __REG_WIDE_T
|
||||
^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t,
|
||||
^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t,
|
||||
^ rm_detail_t *, size_t, regmatch_t [], int);
|
||||
^ #endif
|
||||
*/
|
||||
@@ -260,7 +246,7 @@ typedef struct {
|
||||
* of character is used for error reports is independent of what kind is used
|
||||
* in matching.
|
||||
*
|
||||
^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
|
||||
^ extern size_t regerror(int, const regex_t *, char *, size_t);
|
||||
*/
|
||||
#define REG_OKAY 0 /* no errors detected */
|
||||
#define REG_NOMATCH 1 /* failed to match */
|
||||
@@ -292,25 +278,25 @@ typedef struct {
|
||||
/* automatically gathered by fwd; do not hand-edit */
|
||||
/* === regproto.h === */
|
||||
#ifndef __REG_NOCHAR
|
||||
int re_comp(regex_t *, __REG_CONST char *, size_t, int);
|
||||
int re_comp(regex_t *, const char *, size_t, int);
|
||||
#endif
|
||||
#ifndef __REG_NOFRONT
|
||||
int regcomp(regex_t *, __REG_CONST char *, int);
|
||||
int regcomp(regex_t *, const char *, int);
|
||||
#endif
|
||||
#ifdef __REG_WIDE_T
|
||||
MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
|
||||
MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
|
||||
#endif
|
||||
#ifndef __REG_NOCHAR
|
||||
int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
|
||||
int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
|
||||
#endif
|
||||
#ifndef __REG_NOFRONT
|
||||
int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
|
||||
int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
|
||||
#endif
|
||||
#ifdef __REG_WIDE_T
|
||||
MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
|
||||
MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
|
||||
#endif
|
||||
MODULE_SCOPE re_void regfree(regex_t *);
|
||||
MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
|
||||
MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t);
|
||||
/* automatically gathered by fwd; do not hand-edit */
|
||||
/* =====^!^===== end forwards =====^!^===== */
|
||||
|
||||
|
||||
+90
-86
@@ -32,7 +32,7 @@ declare 0 {
|
||||
const char *version, const void *clientData)
|
||||
}
|
||||
declare 1 {
|
||||
CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version, int exact,
|
||||
void *clientDataPtr)
|
||||
}
|
||||
@@ -154,7 +154,7 @@ declare 35 {
|
||||
}
|
||||
declare 36 {
|
||||
int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
|
||||
const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
|
||||
}
|
||||
declare 37 {
|
||||
int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
|
||||
@@ -166,7 +166,7 @@ declare 39 {
|
||||
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
|
||||
}
|
||||
declare 40 {
|
||||
CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
|
||||
const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
|
||||
}
|
||||
declare 41 {
|
||||
char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
|
||||
@@ -285,9 +285,10 @@ declare 75 {
|
||||
declare 76 {
|
||||
void Tcl_BackgroundError(Tcl_Interp *interp)
|
||||
}
|
||||
declare 77 {
|
||||
char Tcl_Backslash(const char *src, int *readPtr)
|
||||
}
|
||||
# Removed in 9.0
|
||||
#declare 77 {
|
||||
# char Tcl_Backslash(const char *src, int *readPtr)
|
||||
#}
|
||||
declare 78 {
|
||||
int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
|
||||
const char *optionList)
|
||||
@@ -306,7 +307,7 @@ declare 82 {
|
||||
int Tcl_CommandComplete(const char *cmd)
|
||||
}
|
||||
declare 83 {
|
||||
char *Tcl_Concat(int argc, CONST84 char *const *argv)
|
||||
char *Tcl_Concat(int argc, const char *const *argv)
|
||||
}
|
||||
declare 84 {
|
||||
int Tcl_ConvertElement(const char *src, char *dst, int flags)
|
||||
@@ -318,7 +319,7 @@ declare 85 {
|
||||
declare 86 {
|
||||
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
|
||||
Tcl_Interp *target, const char *targetCmd, int argc,
|
||||
CONST84 char *const *argv)
|
||||
const char *const *argv)
|
||||
}
|
||||
declare 87 {
|
||||
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
|
||||
@@ -352,11 +353,11 @@ declare 93 {
|
||||
declare 94 {
|
||||
Tcl_Interp *Tcl_CreateInterp(void)
|
||||
}
|
||||
declare 95 {
|
||||
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
|
||||
int numArgs, Tcl_ValueType *argTypes,
|
||||
Tcl_MathProc *proc, ClientData clientData)
|
||||
}
|
||||
#declare 95 {
|
||||
# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
|
||||
# int numArgs, Tcl_ValueType *argTypes,
|
||||
# Tcl_MathProc *proc, ClientData clientData)
|
||||
#}
|
||||
declare 96 {
|
||||
Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
@@ -461,18 +462,18 @@ declare 126 {
|
||||
int Tcl_Eof(Tcl_Channel chan)
|
||||
}
|
||||
declare 127 {
|
||||
CONST84_RETURN char *Tcl_ErrnoId(void)
|
||||
const char *Tcl_ErrnoId(void)
|
||||
}
|
||||
declare 128 {
|
||||
CONST84_RETURN char *Tcl_ErrnoMsg(int err)
|
||||
const char *Tcl_ErrnoMsg(int err)
|
||||
}
|
||||
declare 129 {
|
||||
int Tcl_Eval(Tcl_Interp *interp, const char *script)
|
||||
}
|
||||
# This is obsolete, use Tcl_FSEvalFile
|
||||
declare 130 {
|
||||
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 130 {
|
||||
# int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
|
||||
#}
|
||||
declare 131 {
|
||||
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
@@ -514,9 +515,10 @@ declare 142 {
|
||||
declare 143 {
|
||||
void Tcl_Finalize(void)
|
||||
}
|
||||
declare 144 {
|
||||
void Tcl_FindExecutable(const char *argv0)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 144 {
|
||||
# void Tcl_FindExecutable(const char *argv0)
|
||||
#}
|
||||
declare 145 {
|
||||
Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
|
||||
Tcl_HashSearch *searchPtr)
|
||||
@@ -529,12 +531,12 @@ declare 147 {
|
||||
}
|
||||
declare 148 {
|
||||
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
|
||||
int *argcPtr, CONST84 char ***argvPtr)
|
||||
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
|
||||
int *argcPtr, const char ***argvPtr)
|
||||
}
|
||||
declare 149 {
|
||||
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
|
||||
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
|
||||
int *objcPtr, Tcl_Obj ***objv)
|
||||
}
|
||||
declare 150 {
|
||||
@@ -559,28 +561,28 @@ declare 155 {
|
||||
int Tcl_GetChannelMode(Tcl_Channel chan)
|
||||
}
|
||||
declare 156 {
|
||||
CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
|
||||
const char *Tcl_GetChannelName(Tcl_Channel chan)
|
||||
}
|
||||
declare 157 {
|
||||
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
|
||||
const char *optionName, Tcl_DString *dsPtr)
|
||||
}
|
||||
declare 158 {
|
||||
CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
|
||||
const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
|
||||
}
|
||||
declare 159 {
|
||||
int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
|
||||
Tcl_CmdInfo *infoPtr)
|
||||
}
|
||||
declare 160 {
|
||||
CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
const char *Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
Tcl_Command command)
|
||||
}
|
||||
declare 161 {
|
||||
int Tcl_GetErrno(void)
|
||||
}
|
||||
declare 162 {
|
||||
CONST84_RETURN char *Tcl_GetHostName(void)
|
||||
const char *Tcl_GetHostName(void)
|
||||
}
|
||||
declare 163 {
|
||||
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
|
||||
@@ -623,22 +625,23 @@ declare 173 {
|
||||
Tcl_Channel Tcl_GetStdChannel(int type)
|
||||
}
|
||||
declare 174 {
|
||||
CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
|
||||
const char *Tcl_GetStringResult(Tcl_Interp *interp)
|
||||
}
|
||||
declare 175 {
|
||||
CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags)
|
||||
}
|
||||
declare 176 {
|
||||
CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, int flags)
|
||||
}
|
||||
declare 177 {
|
||||
int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
|
||||
}
|
||||
declare 178 {
|
||||
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
# Removed in Tcl 9.0
|
||||
#declare 177 {
|
||||
# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
|
||||
#}
|
||||
#declare 178 {
|
||||
# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
#}
|
||||
declare 179 {
|
||||
int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
|
||||
const char *hiddenCmdToken)
|
||||
@@ -663,7 +666,7 @@ declare 185 {
|
||||
}
|
||||
# Obsolete, use Tcl_FSJoinPath
|
||||
declare 186 {
|
||||
char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
|
||||
char *Tcl_JoinPath(int argc, const char *const *argv,
|
||||
Tcl_DString *resultPtr)
|
||||
}
|
||||
declare 187 {
|
||||
@@ -686,7 +689,7 @@ declare 191 {
|
||||
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
|
||||
}
|
||||
declare 192 {
|
||||
char *Tcl_Merge(int argc, CONST84 char *const *argv)
|
||||
char *Tcl_Merge(int argc, const char *const *argv)
|
||||
}
|
||||
declare 193 {
|
||||
Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
|
||||
@@ -704,7 +707,7 @@ declare 196 {
|
||||
}
|
||||
declare 197 {
|
||||
Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
|
||||
CONST84 char **argv, int flags)
|
||||
const char **argv, int flags)
|
||||
}
|
||||
# This is obsolete, use Tcl_FSOpenFileChannel
|
||||
declare 198 {
|
||||
@@ -730,7 +733,7 @@ declare 203 {
|
||||
int Tcl_PutEnv(const char *assignment)
|
||||
}
|
||||
declare 204 {
|
||||
CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
|
||||
const char *Tcl_PosixError(Tcl_Interp *interp)
|
||||
}
|
||||
declare 205 {
|
||||
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
|
||||
@@ -766,7 +769,7 @@ declare 214 {
|
||||
}
|
||||
declare 215 {
|
||||
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
|
||||
CONST84 char **startPtr, CONST84 char **endPtr)
|
||||
const char **startPtr, const char **endPtr)
|
||||
}
|
||||
declare 216 {
|
||||
void Tcl_Release(ClientData clientData)
|
||||
@@ -780,10 +783,10 @@ declare 218 {
|
||||
declare 219 {
|
||||
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
|
||||
}
|
||||
# Obsolete
|
||||
declare 220 {
|
||||
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
|
||||
}
|
||||
# Removed in Tcl 9
|
||||
#declare 220 {
|
||||
# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
|
||||
#}
|
||||
declare 221 {
|
||||
int Tcl_ServiceAll(void)
|
||||
}
|
||||
@@ -837,29 +840,29 @@ declare 236 {
|
||||
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
|
||||
}
|
||||
declare 237 {
|
||||
CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *newValue, int flags)
|
||||
}
|
||||
declare 238 {
|
||||
CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, const char *newValue, int flags)
|
||||
}
|
||||
declare 239 {
|
||||
CONST84_RETURN char *Tcl_SignalId(int sig)
|
||||
const char *Tcl_SignalId(int sig)
|
||||
}
|
||||
declare 240 {
|
||||
CONST84_RETURN char *Tcl_SignalMsg(int sig)
|
||||
const char *Tcl_SignalMsg(int sig)
|
||||
}
|
||||
declare 241 {
|
||||
void Tcl_SourceRCFile(Tcl_Interp *interp)
|
||||
}
|
||||
declare 242 {
|
||||
int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
|
||||
CONST84 char ***argvPtr)
|
||||
const char ***argvPtr)
|
||||
}
|
||||
# Obsolete, use Tcl_FSSplitPath
|
||||
declare 243 {
|
||||
void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
|
||||
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
|
||||
}
|
||||
declare 244 {
|
||||
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
|
||||
@@ -868,10 +871,10 @@ declare 244 {
|
||||
declare 245 {
|
||||
int Tcl_StringMatch(const char *str, const char *pattern)
|
||||
}
|
||||
# Obsolete
|
||||
declare 246 {
|
||||
int Tcl_TellOld(Tcl_Channel chan)
|
||||
}
|
||||
# Removed in Tcl 9
|
||||
#declare 246 {
|
||||
# int Tcl_TellOld(Tcl_Channel chan)
|
||||
#}
|
||||
declare 247 {
|
||||
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
|
||||
Tcl_VarTraceProc *proc, ClientData clientData)
|
||||
@@ -955,15 +958,15 @@ declare 269 {
|
||||
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
|
||||
}
|
||||
declare 270 {
|
||||
CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
CONST84 char **termPtr)
|
||||
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
const char **termPtr)
|
||||
}
|
||||
declare 271 {
|
||||
CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
declare 272 {
|
||||
CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version, int exact,
|
||||
void *clientDataPtr)
|
||||
}
|
||||
@@ -973,7 +976,7 @@ declare 273 {
|
||||
}
|
||||
# TIP #268: The internally used new Require function is in slot 573.
|
||||
declare 274 {
|
||||
CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
declare 275 {
|
||||
@@ -1087,7 +1090,7 @@ declare 301 {
|
||||
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
|
||||
}
|
||||
declare 302 {
|
||||
CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
|
||||
const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
|
||||
}
|
||||
declare 303 {
|
||||
void Tcl_GetEncodingNames(Tcl_Interp *interp)
|
||||
@@ -1163,7 +1166,7 @@ declare 324 {
|
||||
int Tcl_UniCharToUtf(int ch, char *buf)
|
||||
}
|
||||
declare 325 {
|
||||
CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
|
||||
const char *Tcl_UtfAtIndex(const char *src, int index)
|
||||
}
|
||||
declare 326 {
|
||||
int Tcl_UtfCharComplete(const char *src, int length)
|
||||
@@ -1172,16 +1175,16 @@ declare 327 {
|
||||
int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
|
||||
}
|
||||
declare 328 {
|
||||
CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
|
||||
const char *Tcl_UtfFindFirst(const char *src, int ch)
|
||||
}
|
||||
declare 329 {
|
||||
CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
|
||||
const char *Tcl_UtfFindLast(const char *src, int ch)
|
||||
}
|
||||
declare 330 {
|
||||
CONST84_RETURN char *Tcl_UtfNext(const char *src)
|
||||
const char *Tcl_UtfNext(const char *src)
|
||||
}
|
||||
declare 331 {
|
||||
CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
|
||||
const char *Tcl_UtfPrev(const char *src, const char *start)
|
||||
}
|
||||
declare 332 {
|
||||
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
|
||||
@@ -1215,7 +1218,7 @@ declare 340 {
|
||||
char *Tcl_GetString(Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 341 {
|
||||
CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
|
||||
const char *Tcl_GetDefaultEncodingDir(void)
|
||||
}
|
||||
declare 342 {
|
||||
void Tcl_SetDefaultEncodingDir(const char *path)
|
||||
@@ -1266,10 +1269,11 @@ declare 356 {
|
||||
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
|
||||
int flags)
|
||||
}
|
||||
declare 357 {
|
||||
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
int count)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 357 {
|
||||
# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
# int count)
|
||||
#}
|
||||
declare 358 {
|
||||
void Tcl_FreeParse(Tcl_Parse *parsePtr)
|
||||
}
|
||||
@@ -1279,7 +1283,7 @@ declare 359 {
|
||||
}
|
||||
declare 360 {
|
||||
int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
|
||||
Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
|
||||
Tcl_Parse *parsePtr, int append, const char **termPtr)
|
||||
}
|
||||
declare 361 {
|
||||
int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
|
||||
@@ -1292,7 +1296,7 @@ declare 362 {
|
||||
declare 363 {
|
||||
int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
|
||||
int numBytes, Tcl_Parse *parsePtr, int append,
|
||||
CONST84 char **termPtr)
|
||||
const char **termPtr)
|
||||
}
|
||||
declare 364 {
|
||||
int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
|
||||
@@ -1408,7 +1412,7 @@ declare 397 {
|
||||
int Tcl_ChannelBuffered(Tcl_Channel chan)
|
||||
}
|
||||
declare 398 {
|
||||
CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
|
||||
const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
|
||||
}
|
||||
declare 399 {
|
||||
Tcl_ChannelTypeVersion Tcl_ChannelVersion(
|
||||
@@ -1548,14 +1552,14 @@ declare 434 {
|
||||
}
|
||||
|
||||
# TIP#15 (math function introspection) dkf
|
||||
declare 435 {
|
||||
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
|
||||
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
|
||||
}
|
||||
declare 436 {
|
||||
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
|
||||
}
|
||||
#declare 435 {
|
||||
# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
|
||||
# int *numArgsPtr, Tcl_ValueType **argTypesPtr,
|
||||
# Tcl_MathProc **procPtr, ClientData *clientDataPtr)
|
||||
#}
|
||||
#declare 436 {
|
||||
# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
|
||||
#}
|
||||
|
||||
# TIP#36 (better access to 'subst') dkf
|
||||
declare 437 {
|
||||
@@ -1617,7 +1621,7 @@ declare 452 {
|
||||
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 453 {
|
||||
const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
Tcl_Obj **objPtrRef)
|
||||
}
|
||||
declare 454 {
|
||||
@@ -1695,7 +1699,7 @@ declare 476 {
|
||||
Tcl_Obj *pathPtr)
|
||||
}
|
||||
declare 477 {
|
||||
CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
|
||||
const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
|
||||
}
|
||||
declare 478 {
|
||||
Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
|
||||
|
||||
+24
-159
@@ -53,13 +53,13 @@ extern "C" {
|
||||
* tools/tcl.hpj.in (not patchlevel, for windows installer)
|
||||
*/
|
||||
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 6
|
||||
#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 3
|
||||
#define TCL_MAJOR_VERSION 9
|
||||
#define TCL_MINOR_VERSION 0
|
||||
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 0
|
||||
|
||||
#define TCL_VERSION "8.6"
|
||||
#define TCL_PATCH_LEVEL "8.6b3"
|
||||
#define TCL_VERSION "9.0"
|
||||
#define TCL_PATCH_LEVEL "9.0a0"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -149,11 +149,6 @@ extern "C" {
|
||||
*/
|
||||
|
||||
#include <stdarg.h>
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define TCL_VARARGS(type, name) (type name, ...)
|
||||
# define TCL_VARARGS_DEF(type, name) (type name, ...)
|
||||
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
|
||||
#endif
|
||||
#if defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
|
||||
#else
|
||||
@@ -243,19 +238,6 @@ extern "C" {
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following _ANSI_ARGS_ macro is to support old extensions
|
||||
* written for older versions of Tcl where it permitted support
|
||||
* for compilers written in the pre-prototype era of C.
|
||||
*
|
||||
* New code should use prototypes.
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# undef _ANSI_ARGS_
|
||||
# define _ANSI_ARGS_(x) x
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Definitions that allow this header file to be used either with or without
|
||||
* ANSI C features.
|
||||
@@ -265,35 +247,6 @@ extern "C" {
|
||||
# define INLINE
|
||||
#endif
|
||||
|
||||
#ifdef NO_CONST
|
||||
# ifndef const
|
||||
# define const
|
||||
# endif
|
||||
#endif
|
||||
#ifndef CONST
|
||||
# define CONST const
|
||||
#endif
|
||||
|
||||
#ifdef USE_NON_CONST
|
||||
# ifdef USE_COMPAT_CONST
|
||||
# error define at most one of USE_NON_CONST and USE_COMPAT_CONST
|
||||
# endif
|
||||
# define CONST84
|
||||
# define CONST84_RETURN
|
||||
#else
|
||||
# ifdef USE_COMPAT_CONST
|
||||
# define CONST84
|
||||
# define CONST84_RETURN const
|
||||
# else
|
||||
# define CONST84 const
|
||||
# define CONST84_RETURN const
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef CONST86
|
||||
# define CONST86 CONST84
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Make sure EXTERN isn't defined elsewhere.
|
||||
*/
|
||||
@@ -498,39 +451,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
|
||||
*/
|
||||
|
||||
typedef struct Tcl_Interp
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
{
|
||||
/* TIP #330: Strongly discourage extensions from using the string
|
||||
* result. */
|
||||
#ifdef USE_INTERP_RESULT
|
||||
char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
|
||||
/* If the last command returned a string
|
||||
* result, this points to it. */
|
||||
void (*freeProc) (char *blockPtr)
|
||||
TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
|
||||
/* Zero means the string result is statically
|
||||
* allocated. TCL_DYNAMIC means it was
|
||||
* allocated with ckalloc and should be freed
|
||||
* with ckfree. Other values give the address
|
||||
* of function to invoke to free the result.
|
||||
* Tcl_Eval must free it before executing next
|
||||
* command. */
|
||||
#else
|
||||
char *resultDontUse; /* Don't use in extensions! */
|
||||
void (*freeProcDontUse) (char *); /* Don't use in extensions! */
|
||||
#endif
|
||||
#ifdef USE_INTERP_ERRORLINE
|
||||
int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
|
||||
/* When TCL_ERROR is returned, this gives the
|
||||
* line number within the command where the
|
||||
* error occurred (1 if first line). */
|
||||
#else
|
||||
int errorLineDontUse; /* Don't use in extensions! */
|
||||
#endif
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
Tcl_Interp;
|
||||
typedef struct Tcl_Interp Tcl_Interp;
|
||||
|
||||
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
|
||||
typedef struct Tcl_Channel_ *Tcl_Channel;
|
||||
@@ -679,8 +600,6 @@ typedef struct stat *Tcl_OldStat_;
|
||||
#define TCL_BREAK 3
|
||||
#define TCL_CONTINUE 4
|
||||
|
||||
#define TCL_RESULT_SIZE 200
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Flags to control what substitutions are performed by Tcl_SubstObj():
|
||||
@@ -691,22 +610,6 @@ typedef struct stat *Tcl_OldStat_;
|
||||
#define TCL_SUBST_BACKSLASHES 004
|
||||
#define TCL_SUBST_ALL 007
|
||||
|
||||
/*
|
||||
* Argument descriptors for math function callbacks in expressions:
|
||||
*/
|
||||
|
||||
typedef enum {
|
||||
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
|
||||
} Tcl_ValueType;
|
||||
|
||||
typedef struct Tcl_Value {
|
||||
Tcl_ValueType type; /* Indicates intValue or doubleValue is valid,
|
||||
* or both. */
|
||||
long intValue; /* Integer value. */
|
||||
double doubleValue; /* Double-precision floating value. */
|
||||
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
|
||||
} Tcl_Value;
|
||||
|
||||
/*
|
||||
* Forward declaration of Tcl_Obj to prevent an error when the forward
|
||||
* reference to Tcl_Obj is encountered in the function types declared below.
|
||||
@@ -714,6 +617,8 @@ typedef struct Tcl_Value {
|
||||
|
||||
struct Tcl_Obj;
|
||||
|
||||
typedef struct Tcl_Obj Tcl_Value;
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Function types defined by Tcl:
|
||||
@@ -726,10 +631,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
|
||||
typedef void (Tcl_CloseProc) (ClientData data);
|
||||
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
|
||||
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char *argv[]);
|
||||
int argc, const char *argv[]);
|
||||
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int level, char *command, Tcl_CmdProc *proc,
|
||||
ClientData cmdClientData, int argc, CONST84 char *argv[]);
|
||||
ClientData cmdClientData, int argc, const char *argv[]);
|
||||
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int level, const char *command, Tcl_Command commandInfo, int objc,
|
||||
struct Tcl_Obj *const *objv);
|
||||
@@ -752,8 +657,6 @@ typedef void (Tcl_FreeProc) (char *blockPtr);
|
||||
typedef void (Tcl_IdleProc) (ClientData clientData);
|
||||
typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
|
||||
Tcl_Interp *interp);
|
||||
typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
Tcl_Value *args, Tcl_Value *resultPtr);
|
||||
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
|
||||
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int objc, struct Tcl_Obj *const *objv);
|
||||
@@ -766,7 +669,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData);
|
||||
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
|
||||
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
|
||||
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
CONST84 char *part1, CONST84 char *part2, int flags);
|
||||
const char *part1, const char *part2, int flags);
|
||||
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
const char *oldName, const char *newName, int flags);
|
||||
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
|
||||
@@ -872,13 +775,7 @@ int Tcl_IsShared(Tcl_Obj *objPtr);
|
||||
*/
|
||||
|
||||
typedef struct Tcl_SavedResult {
|
||||
char *result;
|
||||
Tcl_FreeProc *freeProc;
|
||||
Tcl_Obj *objResultPtr;
|
||||
char *appendResult;
|
||||
int appendAvl;
|
||||
int appendUsed;
|
||||
char resultSpace[TCL_RESULT_SIZE+1];
|
||||
} Tcl_SavedResult;
|
||||
|
||||
/*
|
||||
@@ -1004,7 +901,6 @@ typedef struct Tcl_DString {
|
||||
|
||||
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
|
||||
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
|
||||
#define Tcl_DStringTrunc Tcl_DStringSetLength
|
||||
|
||||
/*
|
||||
* Definitions for the maximum number of digits of precision that may be
|
||||
@@ -1123,17 +1019,6 @@ typedef struct Tcl_DString {
|
||||
|
||||
#define TCL_ALLOW_INLINE_COMPILATION 0x20000
|
||||
|
||||
/*
|
||||
* The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
|
||||
* always parsed whenever the part2 is NULL. (This is to avoid a common error
|
||||
* when converting code to use the new object based APIs and forgetting to
|
||||
* give the flag)
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define TCL_PARSE_PART1 0x400
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Types for linked variables:
|
||||
*/
|
||||
@@ -1417,8 +1302,8 @@ typedef struct Tcl_Time {
|
||||
long usec; /* Microseconds. */
|
||||
} Tcl_Time;
|
||||
|
||||
typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
|
||||
typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
|
||||
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
|
||||
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
|
||||
|
||||
/*
|
||||
* TIP #233 (Virtualized Time)
|
||||
@@ -1492,14 +1377,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData,
|
||||
typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf,
|
||||
int toRead, int *errorCodePtr);
|
||||
typedef int (Tcl_DriverOutputProc) (ClientData instanceData,
|
||||
CONST84 char *buf, int toWrite, int *errorCodePtr);
|
||||
const char *buf, int toWrite, int *errorCodePtr);
|
||||
typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset,
|
||||
int mode, int *errorCodePtr);
|
||||
typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData,
|
||||
Tcl_Interp *interp, const char *optionName,
|
||||
const char *value);
|
||||
typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData,
|
||||
Tcl_Interp *interp, CONST84 char *optionName,
|
||||
Tcl_Interp *interp, const char *optionName,
|
||||
Tcl_DString *dsPtr);
|
||||
typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask);
|
||||
typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData,
|
||||
@@ -1690,7 +1575,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
int nextCheckpoint);
|
||||
typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
|
||||
Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
|
||||
typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
|
||||
typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
|
||||
Tcl_Obj **objPtrRef);
|
||||
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
|
||||
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
|
||||
@@ -2394,8 +2279,8 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
|
||||
* main library in case an extension is statically linked into an application.
|
||||
*/
|
||||
|
||||
const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact);
|
||||
const char * TclInitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact, int major, int magic);
|
||||
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
const char *version, int epoch, int revision);
|
||||
|
||||
@@ -2403,7 +2288,10 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
* When not using stubs, make it a macro.
|
||||
*/
|
||||
|
||||
#ifndef USE_TCL_STUBS
|
||||
#ifdef USE_TCL_STUBS
|
||||
#define Tcl_InitStubs(interp, version, exact) \
|
||||
TclInitStubs(interp, version, exact, TCL_MAJOR_VERSION, TCL_STUB_MAGIC)
|
||||
#else
|
||||
#define Tcl_InitStubs(interp, version, exact) \
|
||||
Tcl_PkgInitStubsCheck(interp, version, exact)
|
||||
#endif
|
||||
@@ -2419,6 +2307,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
|
||||
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
|
||||
(Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
|
||||
EXTERN void Tcl_FindExecutable(const char *argv0);
|
||||
EXTERN void Tcl_MainEx(int argc, char **argv,
|
||||
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
|
||||
@@ -2603,33 +2492,9 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
# undef Tcl_EvalObj
|
||||
# define Tcl_EvalObj(interp,objPtr) \
|
||||
Tcl_EvalObjEx((interp),(objPtr),0)
|
||||
# undef Tcl_GlobalEvalObj
|
||||
# define Tcl_GlobalEvalObj(interp,objPtr) \
|
||||
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
|
||||
|
||||
/*
|
||||
* These function have been renamed. The old names are deprecated, but we
|
||||
* define these macros for backwards compatibilty.
|
||||
*/
|
||||
|
||||
# define Tcl_Ckalloc Tcl_Alloc
|
||||
# define Tcl_Ckfree Tcl_Free
|
||||
# define Tcl_Ckrealloc Tcl_Realloc
|
||||
# define Tcl_Return Tcl_SetResult
|
||||
# define Tcl_TildeSubst Tcl_TranslateFileName
|
||||
# define panic Tcl_Panic
|
||||
# define panicVA Tcl_PanicVA
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Convenience declaration of Tcl_AppInit for backwards compatibility. This
|
||||
* function is not *implemented* by the tcl library, so the storage class is
|
||||
* neither DLLEXPORT nor DLLIMPORT.
|
||||
*/
|
||||
|
||||
extern Tcl_AppInitProc Tcl_AppInit;
|
||||
|
||||
#endif /* RC_INVOKED */
|
||||
|
||||
/*
|
||||
|
||||
+9
-546
@@ -40,18 +40,6 @@
|
||||
# define MAX_EXACT 9007199254740991.0
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following structure defines the client data for a math function
|
||||
* registered with Tcl_CreateMathFunc
|
||||
*/
|
||||
|
||||
typedef struct OldMathFuncData {
|
||||
Tcl_MathProc *proc; /* Handler function */
|
||||
int numArgs; /* Number of args expected */
|
||||
Tcl_ValueType *argTypes; /* Types of the args */
|
||||
ClientData clientData; /* Client data for the handler function */
|
||||
} OldMathFuncData;
|
||||
|
||||
/*
|
||||
* This is the script cancellation struct and hash table. The hash table is
|
||||
* used to keep track of the information necessary to process script
|
||||
@@ -136,8 +124,6 @@ static Tcl_NRPostProc NRCoroutineExitCallback;
|
||||
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
|
||||
|
||||
static Tcl_NRPostProc NRRunObjProc;
|
||||
static Tcl_ObjCmdProc OldMathFuncProc;
|
||||
static void OldMathFuncDeleteProc(ClientData clientData);
|
||||
static void ProcessUnexpectedResult(Tcl_Interp *interp,
|
||||
int returnCode);
|
||||
static int RewindCoroutine(CoroutineData *corPtr, int result);
|
||||
@@ -205,9 +191,6 @@ static const CmdInfo builtInCmds[] = {
|
||||
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, 1},
|
||||
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, 1},
|
||||
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, 1},
|
||||
#ifndef EXCLUDE_OBSOLETE_COMMANDS
|
||||
{"case", Tcl_CaseObjCmd, NULL, NULL, 1},
|
||||
#endif
|
||||
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, 1},
|
||||
{"concat", Tcl_ConcatObjCmd, NULL, NULL, 1},
|
||||
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1},
|
||||
@@ -502,8 +485,7 @@ Tcl_CreateInterp(void)
|
||||
iPtr = ckalloc(sizeof(Interp));
|
||||
interp = (Tcl_Interp *) iPtr;
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->freeProc = NULL;
|
||||
iPtr->legacyResult = NULL;
|
||||
iPtr->errorLine = 0;
|
||||
iPtr->objResultPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(iPtr->objResultPtr);
|
||||
@@ -559,10 +541,6 @@ Tcl_CreateInterp(void)
|
||||
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
|
||||
iPtr->lookupNsPtr = NULL;
|
||||
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
iPtr->appendUsed = 0;
|
||||
|
||||
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
|
||||
iPtr->packageUnknown = NULL;
|
||||
|
||||
@@ -590,7 +568,6 @@ Tcl_CreateInterp(void)
|
||||
iPtr->emptyObjPtr = Tcl_NewObj();
|
||||
/* Another empty object. */
|
||||
Tcl_IncrRefCount(iPtr->emptyObjPtr);
|
||||
iPtr->resultSpace[0] = 0;
|
||||
iPtr->threadId = Tcl_GetCurrentThread();
|
||||
|
||||
/* TIP #378 */
|
||||
@@ -1492,7 +1469,6 @@ DeleteInterpProc(
|
||||
*/
|
||||
|
||||
Tcl_FreeResult(interp);
|
||||
iPtr->result = NULL;
|
||||
Tcl_DecrRefCount(iPtr->objResultPtr);
|
||||
iPtr->objResultPtr = NULL;
|
||||
Tcl_DecrRefCount(iPtr->ecVar);
|
||||
@@ -1514,10 +1490,6 @@ DeleteInterpProc(
|
||||
if (iPtr->returnOpts) {
|
||||
Tcl_DecrRefCount(iPtr->returnOpts);
|
||||
}
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
iPtr->appendResult = NULL;
|
||||
}
|
||||
TclFreePackageInfo(iPtr);
|
||||
while (iPtr->tracePtr != NULL) {
|
||||
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
|
||||
@@ -2391,7 +2363,7 @@ TclInvokeStringCommand(
|
||||
* in the Command structure.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl string result value.
|
||||
* A standard Tcl result value.
|
||||
*
|
||||
* Side effects:
|
||||
* Besides those side effects of the called Tcl_CmdProc,
|
||||
@@ -2431,13 +2403,6 @@ TclInvokeObjectCommand(
|
||||
cmdPtr->objClientData, argc, objv);
|
||||
}
|
||||
|
||||
/*
|
||||
* Move the interpreter's object result to the string result, then reset
|
||||
* the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
/*
|
||||
* Decrement the ref counts for the argument objects created above, then
|
||||
* free the objv array if malloc'ed storage was used.
|
||||
@@ -3427,360 +3392,6 @@ TclCleanupCommand(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CreateMathFunc --
|
||||
*
|
||||
* Creates a new math function for expressions in a given interpreter.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The Tcl function defined by "name" is created or redefined. If the
|
||||
* function already exists then its definition is replaced; this includes
|
||||
* the builtin functions. Redefining a builtin function forces all
|
||||
* existing code to be invalidated since that code may be compiled using
|
||||
* an instruction specific to the replaced function. In addition,
|
||||
* redefioning a non-builtin function will force existing code to be
|
||||
* invalidated if the number of arguments has changed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
Tcl_CreateMathFunc(
|
||||
Tcl_Interp *interp, /* Interpreter in which function is to be
|
||||
* available. */
|
||||
const char *name, /* Name of function (e.g. "sin"). */
|
||||
int numArgs, /* Nnumber of arguments required by
|
||||
* function. */
|
||||
Tcl_ValueType *argTypes, /* Array of types acceptable for each
|
||||
* argument. */
|
||||
Tcl_MathProc *proc, /* C function that implements the math
|
||||
* function. */
|
||||
ClientData clientData) /* Additional value to pass to the
|
||||
* function. */
|
||||
{
|
||||
Tcl_DString bigName;
|
||||
OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
|
||||
|
||||
data->proc = proc;
|
||||
data->numArgs = numArgs;
|
||||
data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
|
||||
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
|
||||
data->clientData = clientData;
|
||||
|
||||
Tcl_DStringInit(&bigName);
|
||||
TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
|
||||
Tcl_DStringAppend(&bigName, name, -1);
|
||||
|
||||
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
|
||||
OldMathFuncProc, data, OldMathFuncDeleteProc);
|
||||
Tcl_DStringFree(&bigName);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* OldMathFuncProc --
|
||||
*
|
||||
* Dispatch to a math function created with Tcl_CreateMathFunc
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* Whatever the math function does.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
OldMathFuncProc(
|
||||
ClientData clientData, /* Ponter to OldMathFuncData describing the
|
||||
* function being called */
|
||||
Tcl_Interp *interp, /* Tcl interpreter */
|
||||
int objc, /* Actual parameter count */
|
||||
Tcl_Obj *const *objv) /* Parameter vector */
|
||||
{
|
||||
Tcl_Obj *valuePtr;
|
||||
OldMathFuncData *dataPtr = clientData;
|
||||
Tcl_Value funcResult, *args;
|
||||
int result;
|
||||
int j, k;
|
||||
double d;
|
||||
|
||||
/*
|
||||
* Check argument count.
|
||||
*/
|
||||
|
||||
if (objc != dataPtr->numArgs + 1) {
|
||||
MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert arguments from Tcl_Obj's to Tcl_Value's.
|
||||
*/
|
||||
|
||||
args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
|
||||
for (j = 1, k = 0; j < objc; ++j, ++k) {
|
||||
/* TODO: Convert to TclGetNumberFromObj? */
|
||||
valuePtr = objv[j];
|
||||
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
|
||||
d = valuePtr->internalRep.doubleValue;
|
||||
result = TCL_OK;
|
||||
}
|
||||
#endif
|
||||
if (result != TCL_OK) {
|
||||
/*
|
||||
* We have a non-numeric argument.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"argument to math function didn't have numeric value",
|
||||
-1));
|
||||
TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
|
||||
ckfree(args);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the object's numeric value to the argument record, converting
|
||||
* it if necessary.
|
||||
*
|
||||
* NOTE: no bignum support; use the new mathfunc interface for that.
|
||||
*/
|
||||
|
||||
args[k].type = dataPtr->argTypes[k];
|
||||
switch (args[k].type) {
|
||||
case TCL_EITHER:
|
||||
if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue)
|
||||
== TCL_OK) {
|
||||
args[k].type = TCL_INT;
|
||||
break;
|
||||
}
|
||||
if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
|
||||
== TCL_OK) {
|
||||
args[k].type = TCL_WIDE_INT;
|
||||
break;
|
||||
}
|
||||
args[k].type = TCL_DOUBLE;
|
||||
/* FALLTHROUGH */
|
||||
|
||||
case TCL_DOUBLE:
|
||||
args[k].doubleValue = d;
|
||||
break;
|
||||
case TCL_INT:
|
||||
if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
|
||||
ckfree(args);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
valuePtr = Tcl_GetObjResult(interp);
|
||||
Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue);
|
||||
Tcl_ResetResult(interp);
|
||||
break;
|
||||
case TCL_WIDE_INT:
|
||||
if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
|
||||
ckfree(args);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
valuePtr = Tcl_GetObjResult(interp);
|
||||
Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
|
||||
Tcl_ResetResult(interp);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Call the function.
|
||||
*/
|
||||
|
||||
errno = 0;
|
||||
result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
|
||||
ckfree(args);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* Return the result of the call.
|
||||
*/
|
||||
|
||||
if (funcResult.type == TCL_INT) {
|
||||
TclNewLongObj(valuePtr, funcResult.intValue);
|
||||
} else if (funcResult.type == TCL_WIDE_INT) {
|
||||
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
|
||||
} else {
|
||||
return CheckDoubleResult(interp, funcResult.doubleValue);
|
||||
}
|
||||
Tcl_SetObjResult(interp, valuePtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* OldMathFuncDeleteProc --
|
||||
*
|
||||
* Cleans up after deleting a math function registered with
|
||||
* Tcl_CreateMathFunc
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Frees allocated memory.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
OldMathFuncDeleteProc(
|
||||
ClientData clientData)
|
||||
{
|
||||
OldMathFuncData *dataPtr = clientData;
|
||||
|
||||
ckfree(dataPtr->argTypes);
|
||||
ckfree(dataPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_GetMathFuncInfo --
|
||||
*
|
||||
* Discovers how a particular math function was created in a given
|
||||
* interpreter.
|
||||
*
|
||||
* Results:
|
||||
* TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
|
||||
* interpreter result if that happens.)
|
||||
*
|
||||
* Side effects:
|
||||
* If this function succeeds, the variables pointed to by the numArgsPtr
|
||||
* and argTypePtr arguments will be updated to detail the arguments
|
||||
* allowed by the function. The variable pointed to by the procPtr
|
||||
* argument will be set to NULL if the function is a builtin function,
|
||||
* and will be set to the address of the C function used to implement the
|
||||
* math function otherwise (in which case the variable pointed to by the
|
||||
* clientDataPtr argument will also be updated.)
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_GetMathFuncInfo(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
int *numArgsPtr,
|
||||
Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr,
|
||||
ClientData *clientDataPtr)
|
||||
{
|
||||
Tcl_Obj *cmdNameObj;
|
||||
Command *cmdPtr;
|
||||
|
||||
/*
|
||||
* Get the command that implements the math function.
|
||||
*/
|
||||
|
||||
TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
|
||||
Tcl_AppendToObj(cmdNameObj, name, -1);
|
||||
Tcl_IncrRefCount(cmdNameObj);
|
||||
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
|
||||
Tcl_DecrRefCount(cmdNameObj);
|
||||
|
||||
/*
|
||||
* Report unknown functions.
|
||||
*/
|
||||
|
||||
if (cmdPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"unknown math function \"%s\"", name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
|
||||
*numArgsPtr = -1;
|
||||
*argTypesPtr = NULL;
|
||||
*procPtr = NULL;
|
||||
*clientDataPtr = NULL;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Retrieve function info for user defined functions; return dummy
|
||||
* information for builtins.
|
||||
*/
|
||||
|
||||
if (cmdPtr->objProc == &OldMathFuncProc) {
|
||||
OldMathFuncData *dataPtr = cmdPtr->clientData;
|
||||
|
||||
*procPtr = dataPtr->proc;
|
||||
*numArgsPtr = dataPtr->numArgs;
|
||||
*argTypesPtr = dataPtr->argTypes;
|
||||
*clientDataPtr = dataPtr->clientData;
|
||||
} else {
|
||||
*procPtr = NULL;
|
||||
*numArgsPtr = -1;
|
||||
*argTypesPtr = NULL;
|
||||
*procPtr = NULL;
|
||||
*clientDataPtr = NULL;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_ListMathFuncs --
|
||||
*
|
||||
* Produces a list of all the math functions defined in a given
|
||||
* interpreter.
|
||||
*
|
||||
* Results:
|
||||
* A pointer to a Tcl_Obj structure with a reference count of zero, or
|
||||
* NULL in the case of an error (in which case a suitable error message
|
||||
* will be left in the interpreter result.)
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_ListMathFuncs(
|
||||
Tcl_Interp *interp,
|
||||
const char *pattern)
|
||||
{
|
||||
Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
|
||||
Tcl_Obj *result;
|
||||
Tcl_InterpState state;
|
||||
|
||||
if (pattern) {
|
||||
Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
|
||||
Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
|
||||
|
||||
Tcl_AppendObjToObj(script, arg);
|
||||
Tcl_DecrRefCount(arg); /* Should tear down patternObj too */
|
||||
}
|
||||
|
||||
state = Tcl_SaveInterpState(interp, TCL_OK);
|
||||
Tcl_IncrRefCount(script);
|
||||
if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
|
||||
result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
|
||||
} else {
|
||||
result = Tcl_NewObj();
|
||||
}
|
||||
Tcl_DecrRefCount(script);
|
||||
Tcl_RestoreInterpState(interp, state);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3794,7 +3405,7 @@ Tcl_ListMathFuncs(
|
||||
* otherwise.
|
||||
*
|
||||
* Side effects:
|
||||
* The interpreters object and string results are cleared.
|
||||
* The interpreter's result is cleared.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -3806,8 +3417,8 @@ TclInterpReady(
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Reset both the interpreter's string and object results and clear out
|
||||
* any previous error information.
|
||||
* Reset the interpreter's result and clear out any previous error
|
||||
* information.
|
||||
*/
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
@@ -4325,24 +3936,9 @@ TclNRRunCallbacks(
|
||||
/* All callbacks down to rootPtr not inclusive
|
||||
* are to be run. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
NRE_callback *callbackPtr;
|
||||
Tcl_NRPostProc *procPtr;
|
||||
|
||||
/*
|
||||
* If the interpreter has a non-empty string result, the result object is
|
||||
* either empty or stale because some function set interp->result
|
||||
* directly. If so, move the string result to the result object, then
|
||||
* reset the string result.
|
||||
*
|
||||
* This only needs to be done for the first item in the list: all other
|
||||
* are for NR function calls, and those are Tcl_Obj based.
|
||||
*/
|
||||
|
||||
if (*(iPtr->result) != 0) {
|
||||
(void) Tcl_GetObjResult(interp);
|
||||
}
|
||||
|
||||
while (TOP_CB(interp) != rootPtr) {
|
||||
callbackPtr = TOP_CB(interp);
|
||||
procPtr = callbackPtr->procPtr;
|
||||
@@ -4822,54 +4418,6 @@ Tcl_EvalTokensStandard(
|
||||
NULL, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_EvalTokens --
|
||||
*
|
||||
* Given an array of tokens parsed from a Tcl command (e.g., the tokens
|
||||
* that make up a word or the index for an array variable) this function
|
||||
* evaluates the tokens and concatenates their values to form a single
|
||||
* result value.
|
||||
*
|
||||
* Results:
|
||||
* The return value is a pointer to a newly allocated Tcl_Obj containing
|
||||
* the value of the array of tokens. The reference count of the returned
|
||||
* object has been incremented. If an error occurs in evaluating the
|
||||
* tokens then a NULL value is returned and an error message is left in
|
||||
* interp's result.
|
||||
*
|
||||
* Side effects:
|
||||
* A new object is allocated to hold the result.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* This uses a non-standard return convention; its use is now deprecated. It
|
||||
* is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
|
||||
* in the core any longer. It is only kept for backward compatibility.
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_EvalTokens(
|
||||
Tcl_Interp *interp, /* Interpreter in which to lookup variables,
|
||||
* execute nested commands, and report
|
||||
* errors. */
|
||||
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
|
||||
* evaluate and concatenate. */
|
||||
int count) /* Number of tokens to consider at tokenPtr.
|
||||
* Must be at least 1. */
|
||||
{
|
||||
Tcl_Obj *resPtr;
|
||||
|
||||
if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
resPtr = Tcl_GetObjResult(interp);
|
||||
Tcl_IncrRefCount(resPtr);
|
||||
Tcl_ResetResult(interp);
|
||||
return resPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -5820,22 +5368,13 @@ Tcl_Eval(
|
||||
* previous call to Tcl_CreateInterp). */
|
||||
const char *script) /* Pointer to TCL command to execute. */
|
||||
{
|
||||
int code = Tcl_EvalEx(interp, script, -1, 0);
|
||||
|
||||
/*
|
||||
* For backwards compatibility with old C code that predates the object
|
||||
* system in Tcl 8.0, we have to mirror the object result back into the
|
||||
* string result (some callers may expect it there).
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
return code;
|
||||
return Tcl_EvalEx(interp, script, -1, 0);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_EvalObj, Tcl_GlobalEvalObj --
|
||||
* Tcl_EvalObj --
|
||||
*
|
||||
* These functions are deprecated but we keep them around for backwards
|
||||
* compatibility reasons.
|
||||
@@ -5857,14 +5396,6 @@ Tcl_EvalObj(
|
||||
{
|
||||
return Tcl_EvalObjEx(interp, objPtr, 0);
|
||||
}
|
||||
#undef Tcl_GlobalEvalObj
|
||||
int
|
||||
Tcl_GlobalEvalObj(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -6327,9 +5858,6 @@ Tcl_ExprLong(
|
||||
Tcl_IncrRefCount(exprPtr);
|
||||
result = Tcl_ExprLongObj(interp, exprPtr, ptr);
|
||||
Tcl_DecrRefCount(exprPtr);
|
||||
if (result != TCL_OK) {
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
}
|
||||
}
|
||||
return result;
|
||||
}
|
||||
@@ -6356,9 +5884,6 @@ Tcl_ExprDouble(
|
||||
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
|
||||
Tcl_DecrRefCount(exprPtr);
|
||||
/* Discard the expression object. */
|
||||
if (result != TCL_OK) {
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
}
|
||||
}
|
||||
return result;
|
||||
}
|
||||
@@ -6384,14 +5909,6 @@ Tcl_ExprBoolean(
|
||||
Tcl_IncrRefCount(exprPtr);
|
||||
result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
|
||||
Tcl_DecrRefCount(exprPtr);
|
||||
if (result != TCL_OK) {
|
||||
/*
|
||||
* Move the interpreter's object result to the string result, then
|
||||
* reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
}
|
||||
@@ -6717,12 +6234,6 @@ Tcl_ExprString(
|
||||
Tcl_DecrRefCount(resultPtr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Force the string rep of the interp result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
return code;
|
||||
}
|
||||
|
||||
@@ -6826,19 +6337,7 @@ Tcl_AddObjErrorInfo(
|
||||
|
||||
iPtr->flags |= ERR_LEGACY_COPY;
|
||||
if (iPtr->errorInfo == NULL) {
|
||||
if (iPtr->result[0] != 0) {
|
||||
/*
|
||||
* The interp's string result is set, apparently by some extension
|
||||
* making a deprecated direct write to it. That extension may
|
||||
* expect interp->result to continue to be set, so we'll take
|
||||
* special pains to avoid clearing it, until we drop support for
|
||||
* interp->result completely.
|
||||
*/
|
||||
|
||||
iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
|
||||
} else {
|
||||
iPtr->errorInfo = iPtr->objResultPtr;
|
||||
}
|
||||
iPtr->errorInfo = iPtr->objResultPtr;
|
||||
Tcl_IncrRefCount(iPtr->errorInfo);
|
||||
if (!iPtr->errorCode) {
|
||||
Tcl_SetErrorCode(interp, "NONE", NULL);
|
||||
@@ -6916,7 +6415,7 @@ Tcl_VarEvalVA(
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl return result. An error message or other result may be
|
||||
* left in interp->result.
|
||||
* left in the interp.
|
||||
*
|
||||
* Side effects:
|
||||
* Depends on what was done by the command.
|
||||
@@ -6939,42 +6438,6 @@ Tcl_VarEval(
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_GlobalEval --
|
||||
*
|
||||
* Evaluate a command at global level in an interpreter.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result is returned, and the interp's result is modified
|
||||
* accordingly.
|
||||
*
|
||||
* Side effects:
|
||||
* The command string is executed in interp, and the execution is carried
|
||||
* out in the variable context of global level (no functions active),
|
||||
* just as if an "uplevel #0" command were being executed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_GlobalEval(
|
||||
Tcl_Interp *interp, /* Interpreter in which to evaluate
|
||||
* command. */
|
||||
const char *command) /* Command to evaluate. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
int result;
|
||||
CallFrame *savedVarFramePtr;
|
||||
|
||||
savedVarFramePtr = iPtr->varFramePtr;
|
||||
iPtr->varFramePtr = iPtr->rootFramePtr;
|
||||
result = Tcl_Eval(interp, command);
|
||||
iPtr->varFramePtr = savedVarFramePtr;
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
@@ -129,143 +129,6 @@ Tcl_BreakObjCmd(
|
||||
return TCL_BREAK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CaseObjCmd --
|
||||
*
|
||||
* This procedure is invoked to process the "case" Tcl command. See the
|
||||
* user documentation for details on what it does. THIS COMMAND IS
|
||||
* OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl object result.
|
||||
*
|
||||
* Side effects:
|
||||
* See the user documentation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Tcl_CaseObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register int i;
|
||||
int body, result, caseObjc;
|
||||
const char *stringPtr, *arg;
|
||||
Tcl_Obj *const *caseObjv;
|
||||
Tcl_Obj *armPtr;
|
||||
|
||||
if (objc < 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"string ?in? ?pattern body ...? ?default body?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
stringPtr = TclGetString(objv[1]);
|
||||
body = -1;
|
||||
|
||||
arg = TclGetString(objv[2]);
|
||||
if (strcmp(arg, "in") == 0) {
|
||||
i = 3;
|
||||
} else {
|
||||
i = 2;
|
||||
}
|
||||
caseObjc = objc - i;
|
||||
caseObjv = objv + i;
|
||||
|
||||
/*
|
||||
* If all of the pattern/command pairs are lumped into a single argument,
|
||||
* split them out again.
|
||||
*/
|
||||
|
||||
if (caseObjc == 1) {
|
||||
Tcl_Obj **newObjv;
|
||||
|
||||
TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
|
||||
caseObjv = newObjv;
|
||||
}
|
||||
|
||||
for (i = 0; i < caseObjc; i += 2) {
|
||||
int patObjc, j;
|
||||
const char **patObjv;
|
||||
const char *pat;
|
||||
unsigned char *p;
|
||||
|
||||
if (i == caseObjc-1) {
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"extra case pattern with no body", -1));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for special case of single pattern (no list) with no
|
||||
* backslash sequences.
|
||||
*/
|
||||
|
||||
pat = TclGetString(caseObjv[i]);
|
||||
for (p = (unsigned char *) pat; *p != '\0'; p++) {
|
||||
if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (*p == '\0') {
|
||||
if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
|
||||
body = i + 1;
|
||||
}
|
||||
if (Tcl_StringMatch(stringPtr, pat)) {
|
||||
body = i + 1;
|
||||
goto match;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* Break up pattern lists, then check each of the patterns in the
|
||||
* list.
|
||||
*/
|
||||
|
||||
result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
for (j = 0; j < patObjc; j++) {
|
||||
if (Tcl_StringMatch(stringPtr, patObjv[j])) {
|
||||
body = i + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
ckfree(patObjv);
|
||||
if (j < patObjc) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
match:
|
||||
if (body != -1) {
|
||||
armPtr = caseObjv[body - 1];
|
||||
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
|
||||
if (result == TCL_ERROR) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (\"%.50s\" arm line %d)",
|
||||
TclGetString(armPtr), Tcl_GetErrorLine(interp)));
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* Nothing matched: return nothing.
|
||||
*/
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+131
-172
@@ -40,7 +40,7 @@ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
const void *clientData);
|
||||
/* 1 */
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact, void *clientDataPtr);
|
||||
/* 2 */
|
||||
@@ -146,8 +146,7 @@ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, double *doublePtr);
|
||||
/* 36 */
|
||||
EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr,
|
||||
CONST84 char *const *tablePtr,
|
||||
Tcl_Obj *objPtr, const char *const *tablePtr,
|
||||
const char *msg, int flags, int *indexPtr);
|
||||
/* 37 */
|
||||
EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src,
|
||||
@@ -159,7 +158,7 @@ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, long *longPtr);
|
||||
/* 40 */
|
||||
EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
|
||||
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
|
||||
/* 41 */
|
||||
EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
|
||||
/* 42 */
|
||||
@@ -249,8 +248,7 @@ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async);
|
||||
EXTERN int Tcl_AsyncReady(void);
|
||||
/* 76 */
|
||||
EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
|
||||
/* 77 */
|
||||
EXTERN char Tcl_Backslash(const char *src, int *readPtr);
|
||||
/* Slot 77 is reserved */
|
||||
/* 78 */
|
||||
EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
|
||||
const char *optionName,
|
||||
@@ -267,7 +265,7 @@ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
|
||||
/* 82 */
|
||||
EXTERN int Tcl_CommandComplete(const char *cmd);
|
||||
/* 83 */
|
||||
EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv);
|
||||
EXTERN char * Tcl_Concat(int argc, const char *const *argv);
|
||||
/* 84 */
|
||||
EXTERN int Tcl_ConvertElement(const char *src, char *dst,
|
||||
int flags);
|
||||
@@ -278,7 +276,7 @@ EXTERN int Tcl_ConvertCountedElement(const char *src,
|
||||
EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
|
||||
const char *slaveCmd, Tcl_Interp *target,
|
||||
const char *targetCmd, int argc,
|
||||
CONST84 char *const *argv);
|
||||
const char *const *argv);
|
||||
/* 87 */
|
||||
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
|
||||
const char *slaveCmd, Tcl_Interp *target,
|
||||
@@ -308,11 +306,7 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
|
||||
ClientData clientData);
|
||||
/* 94 */
|
||||
EXTERN Tcl_Interp * Tcl_CreateInterp(void);
|
||||
/* 95 */
|
||||
EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp,
|
||||
const char *name, int numArgs,
|
||||
Tcl_ValueType *argTypes, Tcl_MathProc *proc,
|
||||
ClientData clientData);
|
||||
/* Slot 95 is reserved */
|
||||
/* 96 */
|
||||
EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_ObjCmdProc *proc,
|
||||
@@ -399,14 +393,12 @@ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr);
|
||||
/* 126 */
|
||||
EXTERN int Tcl_Eof(Tcl_Channel chan);
|
||||
/* 127 */
|
||||
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
|
||||
EXTERN const char * Tcl_ErrnoId(void);
|
||||
/* 128 */
|
||||
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
|
||||
EXTERN const char * Tcl_ErrnoMsg(int err);
|
||||
/* 129 */
|
||||
EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
|
||||
/* 130 */
|
||||
EXTERN int Tcl_EvalFile(Tcl_Interp *interp,
|
||||
const char *fileName);
|
||||
/* Slot 130 is reserved */
|
||||
/* 131 */
|
||||
EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
/* 132 */
|
||||
@@ -443,8 +435,7 @@ EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr);
|
||||
/* 143 */
|
||||
EXTERN void Tcl_Finalize(void);
|
||||
/* 144 */
|
||||
EXTERN void Tcl_FindExecutable(const char *argv0);
|
||||
/* Slot 144 is reserved */
|
||||
/* 145 */
|
||||
EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
|
||||
Tcl_HashSearch *searchPtr);
|
||||
@@ -456,13 +447,13 @@ EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
|
||||
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
|
||||
const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr,
|
||||
CONST84 char **targetCmdPtr, int *argcPtr,
|
||||
CONST84 char ***argvPtr);
|
||||
const char **targetCmdPtr, int *argcPtr,
|
||||
const char ***argvPtr);
|
||||
/* 149 */
|
||||
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
|
||||
const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr,
|
||||
CONST84 char **targetCmdPtr, int *objcPtr,
|
||||
const char **targetCmdPtr, int *objcPtr,
|
||||
Tcl_Obj ***objv);
|
||||
/* 150 */
|
||||
EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp,
|
||||
@@ -481,23 +472,23 @@ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan);
|
||||
/* 155 */
|
||||
EXTERN int Tcl_GetChannelMode(Tcl_Channel chan);
|
||||
/* 156 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
|
||||
EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan);
|
||||
/* 157 */
|
||||
EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
|
||||
Tcl_Channel chan, const char *optionName,
|
||||
Tcl_DString *dsPtr);
|
||||
/* 158 */
|
||||
EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
|
||||
EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
|
||||
/* 159 */
|
||||
EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_CmdInfo *infoPtr);
|
||||
/* 160 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
Tcl_Command command);
|
||||
/* 161 */
|
||||
EXTERN int Tcl_GetErrno(void);
|
||||
/* 162 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
|
||||
EXTERN const char * Tcl_GetHostName(void);
|
||||
/* 163 */
|
||||
EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp,
|
||||
Tcl_Interp *slaveInterp);
|
||||
@@ -533,20 +524,15 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
|
||||
/* 173 */
|
||||
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
|
||||
/* 174 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp);
|
||||
/* 175 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
|
||||
const char *varName, int flags);
|
||||
/* 176 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
|
||||
const char *part1, const char *part2,
|
||||
EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags);
|
||||
/* 177 */
|
||||
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
|
||||
const char *command);
|
||||
/* 178 */
|
||||
EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
/* 176 */
|
||||
EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, int flags);
|
||||
/* Slot 177 is reserved */
|
||||
/* Slot 178 is reserved */
|
||||
/* 179 */
|
||||
EXTERN int Tcl_HideCommand(Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
@@ -565,7 +551,7 @@ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp);
|
||||
/* 185 */
|
||||
EXTERN int Tcl_IsSafe(Tcl_Interp *interp);
|
||||
/* 186 */
|
||||
EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv,
|
||||
EXTERN char * Tcl_JoinPath(int argc, const char *const *argv,
|
||||
Tcl_DString *resultPtr);
|
||||
/* 187 */
|
||||
EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
|
||||
@@ -578,7 +564,7 @@ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp);
|
||||
/* 191 */
|
||||
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket);
|
||||
/* 192 */
|
||||
EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv);
|
||||
EXTERN char * Tcl_Merge(int argc, const char *const *argv);
|
||||
/* 193 */
|
||||
EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
|
||||
/* 194 */
|
||||
@@ -592,7 +578,7 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
|
||||
int flags);
|
||||
/* 197 */
|
||||
EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
|
||||
CONST84 char **argv, int flags);
|
||||
const char **argv, int flags);
|
||||
/* 198 */
|
||||
EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp,
|
||||
const char *fileName, const char *modeString,
|
||||
@@ -614,7 +600,7 @@ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value,
|
||||
/* 203 */
|
||||
EXTERN int Tcl_PutEnv(const char *assignment);
|
||||
/* 204 */
|
||||
EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_PosixError(Tcl_Interp *interp);
|
||||
/* 205 */
|
||||
EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr,
|
||||
Tcl_QueuePosition position);
|
||||
@@ -644,8 +630,7 @@ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
|
||||
const char *pattern);
|
||||
/* 215 */
|
||||
EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
|
||||
CONST84 char **startPtr,
|
||||
CONST84 char **endPtr);
|
||||
const char **startPtr, const char **endPtr);
|
||||
/* 216 */
|
||||
EXTERN void Tcl_Release(ClientData clientData);
|
||||
/* 217 */
|
||||
@@ -655,8 +640,7 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
|
||||
/* 219 */
|
||||
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
|
||||
int *flagPtr);
|
||||
/* 220 */
|
||||
EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
|
||||
/* Slot 220 is reserved */
|
||||
/* 221 */
|
||||
EXTERN int Tcl_ServiceAll(void);
|
||||
/* 222 */
|
||||
@@ -699,26 +683,25 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp,
|
||||
/* 236 */
|
||||
EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type);
|
||||
/* 237 */
|
||||
EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
|
||||
const char *varName, const char *newValue,
|
||||
int flags);
|
||||
/* 238 */
|
||||
EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
|
||||
const char *part1, const char *part2,
|
||||
EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *newValue, int flags);
|
||||
/* 238 */
|
||||
EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, const char *newValue,
|
||||
int flags);
|
||||
/* 239 */
|
||||
EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
|
||||
EXTERN const char * Tcl_SignalId(int sig);
|
||||
/* 240 */
|
||||
EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
|
||||
EXTERN const char * Tcl_SignalMsg(int sig);
|
||||
/* 241 */
|
||||
EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp);
|
||||
/* 242 */
|
||||
EXTERN int Tcl_SplitList(Tcl_Interp *interp,
|
||||
const char *listStr, int *argcPtr,
|
||||
CONST84 char ***argvPtr);
|
||||
const char ***argvPtr);
|
||||
/* 243 */
|
||||
EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
|
||||
CONST84 char ***argvPtr);
|
||||
const char ***argvPtr);
|
||||
/* 244 */
|
||||
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
|
||||
const char *pkgName,
|
||||
@@ -726,8 +709,7 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
|
||||
Tcl_PackageInitProc *safeInitProc);
|
||||
/* 245 */
|
||||
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
|
||||
/* 246 */
|
||||
EXTERN int Tcl_TellOld(Tcl_Channel chan);
|
||||
/* Slot 246 is reserved */
|
||||
/* 247 */
|
||||
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags, Tcl_VarTraceProc *proc,
|
||||
@@ -806,23 +788,21 @@ EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
|
||||
/* 269 */
|
||||
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
|
||||
/* 270 */
|
||||
EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
|
||||
const char *start, CONST84 char **termPtr);
|
||||
EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
const char **termPtr);
|
||||
/* 271 */
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact);
|
||||
EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
/* 272 */
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact, void *clientDataPtr);
|
||||
/* 273 */
|
||||
EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
|
||||
const char *version);
|
||||
/* 274 */
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact);
|
||||
EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
/* 275 */
|
||||
EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
|
||||
va_list argList);
|
||||
@@ -896,7 +876,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void);
|
||||
/* 301 */
|
||||
EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
|
||||
/* 302 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
|
||||
EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding);
|
||||
/* 303 */
|
||||
EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp);
|
||||
/* 304 */
|
||||
@@ -955,20 +935,20 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch);
|
||||
/* 324 */
|
||||
EXTERN int Tcl_UniCharToUtf(int ch, char *buf);
|
||||
/* 325 */
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
|
||||
EXTERN const char * Tcl_UtfAtIndex(const char *src, int index);
|
||||
/* 326 */
|
||||
EXTERN int Tcl_UtfCharComplete(const char *src, int length);
|
||||
/* 327 */
|
||||
EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr,
|
||||
char *dst);
|
||||
/* 328 */
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
|
||||
EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch);
|
||||
/* 329 */
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
|
||||
EXTERN const char * Tcl_UtfFindLast(const char *src, int ch);
|
||||
/* 330 */
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
|
||||
EXTERN const char * Tcl_UtfNext(const char *src);
|
||||
/* 331 */
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
|
||||
EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
|
||||
/* 332 */
|
||||
EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp,
|
||||
Tcl_Encoding encoding, const char *src,
|
||||
@@ -996,7 +976,7 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
|
||||
/* 340 */
|
||||
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
|
||||
/* 341 */
|
||||
EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
|
||||
EXTERN const char * Tcl_GetDefaultEncodingDir(void);
|
||||
/* 342 */
|
||||
EXTERN void Tcl_SetDefaultEncodingDir(const char *path);
|
||||
/* 343 */
|
||||
@@ -1032,9 +1012,7 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
|
||||
/* 356 */
|
||||
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *patObj, int flags);
|
||||
/* 357 */
|
||||
EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
|
||||
Tcl_Token *tokenPtr, int count);
|
||||
/* Slot 357 is reserved */
|
||||
/* 358 */
|
||||
EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
|
||||
/* 359 */
|
||||
@@ -1045,7 +1023,7 @@ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_ParseBraces(Tcl_Interp *interp,
|
||||
const char *start, int numBytes,
|
||||
Tcl_Parse *parsePtr, int append,
|
||||
CONST84 char **termPtr);
|
||||
const char **termPtr);
|
||||
/* 361 */
|
||||
EXTERN int Tcl_ParseCommand(Tcl_Interp *interp,
|
||||
const char *start, int numBytes, int nested,
|
||||
@@ -1057,7 +1035,7 @@ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
|
||||
EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp,
|
||||
const char *start, int numBytes,
|
||||
Tcl_Parse *parsePtr, int append,
|
||||
CONST84 char **termPtr);
|
||||
const char **termPtr);
|
||||
/* 364 */
|
||||
EXTERN int Tcl_ParseVarName(Tcl_Interp *interp,
|
||||
const char *start, int numBytes,
|
||||
@@ -1147,8 +1125,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan);
|
||||
/* 397 */
|
||||
EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan);
|
||||
/* 398 */
|
||||
EXTERN CONST84_RETURN char * Tcl_ChannelName(
|
||||
const Tcl_ChannelType *chanTypePtr);
|
||||
EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
|
||||
/* 399 */
|
||||
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
|
||||
const Tcl_ChannelType *chanTypePtr);
|
||||
@@ -1253,15 +1230,8 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
|
||||
/* 434 */
|
||||
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
|
||||
int *lengthPtr);
|
||||
/* 435 */
|
||||
EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
|
||||
const char *name, int *numArgsPtr,
|
||||
Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr,
|
||||
ClientData *clientDataPtr);
|
||||
/* 436 */
|
||||
EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
|
||||
const char *pattern);
|
||||
/* Slot 435 is reserved */
|
||||
/* Slot 436 is reserved */
|
||||
/* 437 */
|
||||
EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int flags);
|
||||
@@ -1311,7 +1281,7 @@ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
|
||||
EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
|
||||
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
|
||||
/* 453 */
|
||||
EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
Tcl_Obj **objPtrRef);
|
||||
/* 454 */
|
||||
EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
|
||||
@@ -1372,7 +1342,7 @@ EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr);
|
||||
EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
|
||||
Tcl_Obj *pathPtr);
|
||||
/* 477 */
|
||||
EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
|
||||
EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
|
||||
/* 478 */
|
||||
EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr);
|
||||
/* 479 */
|
||||
@@ -1823,7 +1793,7 @@ typedef struct TclStubs {
|
||||
const TclStubHooks *hooks;
|
||||
|
||||
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
|
||||
CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
|
||||
const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
|
||||
void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
|
||||
char * (*tcl_Alloc) (unsigned int size); /* 3 */
|
||||
void (*tcl_Free) (char *ptr); /* 4 */
|
||||
@@ -1874,11 +1844,11 @@ typedef struct TclStubs {
|
||||
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
|
||||
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
|
||||
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
|
||||
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
|
||||
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
|
||||
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
|
||||
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
|
||||
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
|
||||
CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
|
||||
const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
|
||||
char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
|
||||
void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
|
||||
int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
|
||||
@@ -1915,16 +1885,16 @@ typedef struct TclStubs {
|
||||
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
|
||||
int (*tcl_AsyncReady) (void); /* 75 */
|
||||
void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
|
||||
char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
|
||||
void (*reserved77)(void);
|
||||
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
|
||||
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
|
||||
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
|
||||
int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
|
||||
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
|
||||
char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
|
||||
char * (*tcl_Concat) (int argc, const 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_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const 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 */
|
||||
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 */
|
||||
@@ -1933,7 +1903,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
|
||||
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
|
||||
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 */
|
||||
void (*reserved95)(void);
|
||||
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_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
|
||||
@@ -1965,10 +1935,10 @@ typedef struct TclStubs {
|
||||
void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
|
||||
void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
|
||||
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
|
||||
CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
|
||||
CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
|
||||
const char * (*tcl_ErrnoId) (void); /* 127 */
|
||||
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
|
||||
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
|
||||
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
|
||||
void (*reserved130)(void);
|
||||
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
|
||||
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
|
||||
void (*tcl_Exit) (int status); /* 133 */
|
||||
@@ -1982,25 +1952,25 @@ typedef struct TclStubs {
|
||||
int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
|
||||
int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
|
||||
void (*tcl_Finalize) (void); /* 143 */
|
||||
void (*tcl_FindExecutable) (const char *argv0); /* 144 */
|
||||
void (*reserved144)(void);
|
||||
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 *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
|
||||
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const 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 */
|
||||
int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
|
||||
ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
|
||||
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
|
||||
CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
|
||||
const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
|
||||
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
|
||||
CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
|
||||
const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
|
||||
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
|
||||
CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
|
||||
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
|
||||
int (*tcl_GetErrno) (void); /* 161 */
|
||||
CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
|
||||
const char * (*tcl_GetHostName) (void); /* 162 */
|
||||
int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
|
||||
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
|
||||
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
|
||||
@@ -2020,11 +1990,11 @@ typedef struct TclStubs {
|
||||
int (*tcl_GetServiceMode) (void); /* 171 */
|
||||
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 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 */
|
||||
CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
|
||||
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
|
||||
int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
|
||||
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
|
||||
const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
|
||||
void (*reserved177)(void);
|
||||
void (*reserved178)(void);
|
||||
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
|
||||
int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
|
||||
void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
|
||||
@@ -2032,25 +2002,25 @@ typedef struct TclStubs {
|
||||
int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
|
||||
int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
|
||||
int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
|
||||
char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */
|
||||
char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
|
||||
int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
|
||||
void (*reserved188)(void);
|
||||
Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
|
||||
int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
|
||||
Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
|
||||
char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */
|
||||
char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
|
||||
Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
|
||||
void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
|
||||
Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
|
||||
Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
|
||||
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
|
||||
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
|
||||
Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
|
||||
Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
|
||||
Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
|
||||
void (*tcl_Preserve) (ClientData data); /* 201 */
|
||||
void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
|
||||
int (*tcl_PutEnv) (const char *assignment); /* 203 */
|
||||
CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
|
||||
const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
|
||||
void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
|
||||
int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
|
||||
void (*tcl_ReapDetachedProcs) (void); /* 207 */
|
||||
@@ -2061,12 +2031,12 @@ typedef struct TclStubs {
|
||||
Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
|
||||
int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
|
||||
int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
|
||||
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
|
||||
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
|
||||
void (*tcl_Release) (ClientData clientData); /* 216 */
|
||||
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
|
||||
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
|
||||
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
|
||||
int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
|
||||
void (*reserved220)(void);
|
||||
int (*tcl_ServiceAll) (void); /* 221 */
|
||||
int (*tcl_ServiceEvent) (int flags); /* 222 */
|
||||
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
|
||||
@@ -2083,16 +2053,16 @@ typedef struct TclStubs {
|
||||
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
|
||||
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
|
||||
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
|
||||
CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
|
||||
CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
|
||||
CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
|
||||
CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
|
||||
const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
|
||||
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
|
||||
const char * (*tcl_SignalId) (int sig); /* 239 */
|
||||
const char * (*tcl_SignalMsg) (int sig); /* 240 */
|
||||
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
|
||||
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
|
||||
void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
|
||||
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
|
||||
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
|
||||
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
|
||||
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
|
||||
int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
|
||||
void (*reserved246)(void);
|
||||
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
|
||||
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
|
||||
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
|
||||
@@ -2116,11 +2086,11 @@ typedef struct TclStubs {
|
||||
void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
|
||||
void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
|
||||
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
|
||||
CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
|
||||
CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
|
||||
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
|
||||
const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
|
||||
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
|
||||
CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
|
||||
int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
|
||||
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
|
||||
@@ -2148,7 +2118,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
|
||||
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
|
||||
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
|
||||
CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
|
||||
const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
|
||||
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
|
||||
int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
|
||||
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
|
||||
@@ -2171,13 +2141,13 @@ typedef struct TclStubs {
|
||||
Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
|
||||
Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
|
||||
int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
|
||||
CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
|
||||
const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
|
||||
int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
|
||||
int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
|
||||
CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
|
||||
CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
|
||||
CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */
|
||||
CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
|
||||
const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
|
||||
const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
|
||||
const char * (*tcl_UtfNext) (const char *src); /* 330 */
|
||||
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
|
||||
int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
|
||||
char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
|
||||
int (*tcl_UtfToLower) (char *src); /* 334 */
|
||||
@@ -2187,7 +2157,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
|
||||
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
|
||||
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
|
||||
CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
|
||||
const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
|
||||
void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
|
||||
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
|
||||
void (*tcl_ServiceModeHook) (int mode); /* 344 */
|
||||
@@ -2203,13 +2173,13 @@ typedef struct TclStubs {
|
||||
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
|
||||
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
|
||||
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
|
||||
Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
|
||||
void (*reserved357)(void);
|
||||
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
|
||||
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
|
||||
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
|
||||
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
|
||||
int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
|
||||
int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
|
||||
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
|
||||
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
|
||||
int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
|
||||
char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
|
||||
int (*tcl_Chdir) (const char *dirName); /* 366 */
|
||||
@@ -2244,7 +2214,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
|
||||
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
|
||||
int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
|
||||
CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
|
||||
const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
|
||||
Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
|
||||
Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
|
||||
Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
|
||||
@@ -2281,8 +2251,8 @@ typedef struct TclStubs {
|
||||
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
|
||||
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
|
||||
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
|
||||
int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
|
||||
Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
|
||||
void (*reserved435)(void);
|
||||
void (*reserved436)(void);
|
||||
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
|
||||
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
|
||||
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
|
||||
@@ -2299,7 +2269,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
|
||||
int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
|
||||
int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
|
||||
const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
|
||||
const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
|
||||
int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
|
||||
int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
|
||||
Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
|
||||
@@ -2323,7 +2293,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
|
||||
ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
|
||||
const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
|
||||
CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
|
||||
const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
|
||||
Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
|
||||
int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
|
||||
void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
|
||||
@@ -2659,8 +2629,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_AsyncReady) /* 75 */
|
||||
#define Tcl_BackgroundError \
|
||||
(tclStubsPtr->tcl_BackgroundError) /* 76 */
|
||||
#define Tcl_Backslash \
|
||||
(tclStubsPtr->tcl_Backslash) /* 77 */
|
||||
/* Slot 77 is reserved */
|
||||
#define Tcl_BadChannelOption \
|
||||
(tclStubsPtr->tcl_BadChannelOption) /* 78 */
|
||||
#define Tcl_CallWhenDeleted \
|
||||
@@ -2695,8 +2664,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
|
||||
#define Tcl_CreateInterp \
|
||||
(tclStubsPtr->tcl_CreateInterp) /* 94 */
|
||||
#define Tcl_CreateMathFunc \
|
||||
(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
|
||||
/* Slot 95 is reserved */
|
||||
#define Tcl_CreateObjCommand \
|
||||
(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
|
||||
#define Tcl_CreateSlave \
|
||||
@@ -2765,8 +2733,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_ErrnoMsg) /* 128 */
|
||||
#define Tcl_Eval \
|
||||
(tclStubsPtr->tcl_Eval) /* 129 */
|
||||
#define Tcl_EvalFile \
|
||||
(tclStubsPtr->tcl_EvalFile) /* 130 */
|
||||
/* Slot 130 is reserved */
|
||||
#define Tcl_EvalObj \
|
||||
(tclStubsPtr->tcl_EvalObj) /* 131 */
|
||||
#define Tcl_EventuallyFree \
|
||||
@@ -2793,8 +2760,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_ExprString) /* 142 */
|
||||
#define Tcl_Finalize \
|
||||
(tclStubsPtr->tcl_Finalize) /* 143 */
|
||||
#define Tcl_FindExecutable \
|
||||
(tclStubsPtr->tcl_FindExecutable) /* 144 */
|
||||
/* Slot 144 is reserved */
|
||||
#define Tcl_FirstHashEntry \
|
||||
(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
|
||||
#define Tcl_Flush \
|
||||
@@ -2865,10 +2831,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_GetVar) /* 175 */
|
||||
#define Tcl_GetVar2 \
|
||||
(tclStubsPtr->tcl_GetVar2) /* 176 */
|
||||
#define Tcl_GlobalEval \
|
||||
(tclStubsPtr->tcl_GlobalEval) /* 177 */
|
||||
#define Tcl_GlobalEvalObj \
|
||||
(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
|
||||
/* Slot 177 is reserved */
|
||||
/* Slot 178 is reserved */
|
||||
#define Tcl_HideCommand \
|
||||
(tclStubsPtr->tcl_HideCommand) /* 179 */
|
||||
#define Tcl_Init \
|
||||
@@ -2950,8 +2914,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_ScanElement) /* 218 */
|
||||
#define Tcl_ScanCountedElement \
|
||||
(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
|
||||
#define Tcl_SeekOld \
|
||||
(tclStubsPtr->tcl_SeekOld) /* 220 */
|
||||
/* Slot 220 is reserved */
|
||||
#define Tcl_ServiceAll \
|
||||
(tclStubsPtr->tcl_ServiceAll) /* 221 */
|
||||
#define Tcl_ServiceEvent \
|
||||
@@ -3002,8 +2965,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_StaticPackage) /* 244 */
|
||||
#define Tcl_StringMatch \
|
||||
(tclStubsPtr->tcl_StringMatch) /* 245 */
|
||||
#define Tcl_TellOld \
|
||||
(tclStubsPtr->tcl_TellOld) /* 246 */
|
||||
/* Slot 246 is reserved */
|
||||
#define Tcl_TraceVar \
|
||||
(tclStubsPtr->tcl_TraceVar) /* 247 */
|
||||
#define Tcl_TraceVar2 \
|
||||
@@ -3223,8 +3185,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
|
||||
#define Tcl_GetRegExpFromObj \
|
||||
(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
|
||||
#define Tcl_EvalTokens \
|
||||
(tclStubsPtr->tcl_EvalTokens) /* 357 */
|
||||
/* Slot 357 is reserved */
|
||||
#define Tcl_FreeParse \
|
||||
(tclStubsPtr->tcl_FreeParse) /* 358 */
|
||||
#define Tcl_LogCommandInfo \
|
||||
@@ -3379,10 +3340,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_GetChannelThread) /* 433 */
|
||||
#define Tcl_GetUnicodeFromObj \
|
||||
(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
|
||||
#define Tcl_GetMathFuncInfo \
|
||||
(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
|
||||
#define Tcl_ListMathFuncs \
|
||||
(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
|
||||
/* Slot 435 is reserved */
|
||||
/* Slot 436 is reserved */
|
||||
#define Tcl_SubstObj \
|
||||
(tclStubsPtr->tcl_SubstObj) /* 437 */
|
||||
#define Tcl_DetachChannel \
|
||||
@@ -3782,15 +3741,15 @@ extern const TclStubs *tclStubsPtr;
|
||||
# undef Tcl_GetStringResult
|
||||
# undef Tcl_Init
|
||||
# undef Tcl_SetPanicProc
|
||||
# undef Tcl_SetVar
|
||||
# undef Tcl_SetVar2
|
||||
# undef Tcl_StaticPackage
|
||||
# undef TclFSGetNativePath
|
||||
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
|
||||
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
|
||||
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
|
||||
# define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
|
||||
# define Tcl_SetVar(interp, varName, newValue, flags) \
|
||||
(tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
|
||||
# define Tcl_SetVar2(interp, part1, part2, newValue, flags) \
|
||||
(tclStubsPtr->tcl_SetVar2(interp, part1, part2, newValue, flags))
|
||||
#endif
|
||||
|
||||
#if defined(_WIN32) && defined(UNICODE)
|
||||
|
||||
+4
-144
@@ -107,63 +107,6 @@ long tclObjsFreed = 0;
|
||||
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
|
||||
#endif /* TCL_COMPILE_STATS */
|
||||
|
||||
/*
|
||||
* Support pre-8.5 bytecodes unless specifically requested otherwise.
|
||||
*/
|
||||
|
||||
#ifndef TCL_SUPPORT_84_BYTECODE
|
||||
#define TCL_SUPPORT_84_BYTECODE 1
|
||||
#endif
|
||||
|
||||
#if TCL_SUPPORT_84_BYTECODE
|
||||
/*
|
||||
* We need to know the tclBuiltinFuncTable to support translation of pre-8.5
|
||||
* math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
const char *name; /* Name of function. */
|
||||
int numArgs; /* Number of arguments for function. */
|
||||
} BuiltinFunc;
|
||||
|
||||
/*
|
||||
* Table describing the built-in math functions. Entries in this table are
|
||||
* indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
|
||||
* operand byte.
|
||||
*/
|
||||
|
||||
static BuiltinFunc const tclBuiltinFuncTable[] = {
|
||||
{"acos", 1},
|
||||
{"asin", 1},
|
||||
{"atan", 1},
|
||||
{"atan2", 2},
|
||||
{"ceil", 1},
|
||||
{"cos", 1},
|
||||
{"cosh", 1},
|
||||
{"exp", 1},
|
||||
{"floor", 1},
|
||||
{"fmod", 2},
|
||||
{"hypot", 2},
|
||||
{"log", 1},
|
||||
{"log10", 1},
|
||||
{"pow", 2},
|
||||
{"sin", 1},
|
||||
{"sinh", 1},
|
||||
{"sqrt", 1},
|
||||
{"tan", 1},
|
||||
{"tanh", 1},
|
||||
{"abs", 1},
|
||||
{"double", 1},
|
||||
{"int", 1},
|
||||
{"rand", 0},
|
||||
{"round", 1},
|
||||
{"srand", 1},
|
||||
{"wide", 1},
|
||||
{NULL, 0},
|
||||
};
|
||||
|
||||
#define LAST_BUILTIN_FUNC 25
|
||||
#endif
|
||||
|
||||
/*
|
||||
* NR_TEBC
|
||||
@@ -2887,90 +2830,15 @@ TEBCresume(
|
||||
return TclNREvalObjv(interp, objc, objv,
|
||||
TCL_EVAL_NOERR, NULL);
|
||||
|
||||
#if TCL_SUPPORT_84_BYTECODE
|
||||
case INST_CALL_BUILTIN_FUNC1:
|
||||
/*
|
||||
* Call one of the built-in pre-8.5 Tcl math functions. This
|
||||
* translates to INST_INVOKE_STK1 with the first argument of
|
||||
* ::tcl::mathfunc::$objv[0]. We need to insert the named math
|
||||
* function into the stack.
|
||||
*/
|
||||
|
||||
opnd = TclGetUInt1AtPtr(pc+1);
|
||||
if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
|
||||
TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
|
||||
Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
|
||||
}
|
||||
|
||||
TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
|
||||
Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
|
||||
|
||||
/*
|
||||
* Only 0, 1 or 2 args.
|
||||
*/
|
||||
|
||||
{
|
||||
int numArgs = tclBuiltinFuncTable[opnd].numArgs;
|
||||
Tcl_Obj *tmpPtr1, *tmpPtr2;
|
||||
|
||||
if (numArgs == 0) {
|
||||
PUSH_OBJECT(objPtr);
|
||||
} else if (numArgs == 1) {
|
||||
tmpPtr1 = POP_OBJECT();
|
||||
PUSH_OBJECT(objPtr);
|
||||
PUSH_OBJECT(tmpPtr1);
|
||||
Tcl_DecrRefCount(tmpPtr1);
|
||||
} else {
|
||||
tmpPtr2 = POP_OBJECT();
|
||||
tmpPtr1 = POP_OBJECT();
|
||||
PUSH_OBJECT(objPtr);
|
||||
PUSH_OBJECT(tmpPtr1);
|
||||
PUSH_OBJECT(tmpPtr2);
|
||||
Tcl_DecrRefCount(tmpPtr1);
|
||||
Tcl_DecrRefCount(tmpPtr2);
|
||||
}
|
||||
objc = numArgs + 1;
|
||||
}
|
||||
pcAdjustment = 2;
|
||||
goto doInvocation;
|
||||
|
||||
case INST_CALL_FUNC1:
|
||||
/*
|
||||
* Call a non-builtin Tcl math function previously registered by a
|
||||
* call to Tcl_CreateMathFunc pre-8.5. This is essentially
|
||||
* INST_INVOKE_STK1 converting the first arg to
|
||||
* ::tcl::mathfunc::$objv[0].
|
||||
*/
|
||||
|
||||
objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function
|
||||
* name is the 0-th argument. */
|
||||
|
||||
objPtr = OBJ_AT_DEPTH(objc-1);
|
||||
TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
|
||||
Tcl_AppendObjToObj(tmpPtr, objPtr);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
|
||||
/*
|
||||
* Variation of PUSH_OBJECT.
|
||||
*/
|
||||
|
||||
OBJ_AT_DEPTH(objc-1) = tmpPtr;
|
||||
Tcl_IncrRefCount(tmpPtr);
|
||||
|
||||
pcAdjustment = 2;
|
||||
goto doInvocation;
|
||||
#else
|
||||
/*
|
||||
* INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
|
||||
* changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
|
||||
* remains for existing bytecode precompiled files.
|
||||
* changes to add a ::tcl::mathfunc namespace in 8.5.
|
||||
*/
|
||||
|
||||
case INST_CALL_BUILTIN_FUNC1:
|
||||
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
|
||||
case INST_CALL_FUNC1:
|
||||
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
|
||||
#endif
|
||||
|
||||
/*
|
||||
* -----------------------------------------------------------------
|
||||
@@ -8567,16 +8435,7 @@ IllegalExprOperandType(
|
||||
}
|
||||
|
||||
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
|
||||
int numBytes;
|
||||
const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
|
||||
|
||||
if (numBytes == 0) {
|
||||
description = "empty string";
|
||||
} else if (TclCheckBadOctal(NULL, bytes)) {
|
||||
description = "invalid octal number";
|
||||
} else {
|
||||
description = "non-numeric string";
|
||||
}
|
||||
description = "non-numeric string";
|
||||
} else if (type == TCL_NUMBER_NAN) {
|
||||
description = "non-numeric floating-point value";
|
||||
} else if (type == TCL_NUMBER_DOUBLE) {
|
||||
@@ -8587,7 +8446,8 @@ IllegalExprOperandType(
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"can't use %s as operand of \"%s\"", description, operator));
|
||||
"can't use %s \"%s\" as operand of \"%s\"", description,
|
||||
Tcl_GetString(opndPtr), operator));
|
||||
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
|
||||
}
|
||||
|
||||
|
||||
@@ -74,13 +74,6 @@ Tcl_RecordAndEval(
|
||||
Tcl_IncrRefCount(cmdPtr);
|
||||
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
|
||||
|
||||
/*
|
||||
* Move the interpreter's object result to the string result, then
|
||||
* reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
/*
|
||||
* Discard the Tcl object created to hold the command.
|
||||
*/
|
||||
|
||||
@@ -7056,47 +7056,6 @@ Tcl_Tell(
|
||||
return curPos + outputBuffered;
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SeekOld, Tcl_TellOld --
|
||||
*
|
||||
* Backward-compatability versions of the seek/tell interface that do not
|
||||
* support 64-bit offsets. This interface is not documented or expected
|
||||
* to be supported indefinitely.
|
||||
*
|
||||
* Results:
|
||||
* As for Tcl_Seek and Tcl_Tell respectively, except truncated to
|
||||
* whatever value will fit in an 'int'.
|
||||
*
|
||||
* Side effects:
|
||||
* As for Tcl_Seek and Tcl_Tell respectively.
|
||||
*
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_SeekOld(
|
||||
Tcl_Channel chan, /* The channel on which to seek. */
|
||||
int offset, /* Offset to seek to. */
|
||||
int mode) /* Relative to which location to seek? */
|
||||
{
|
||||
Tcl_WideInt wOffset, wResult;
|
||||
|
||||
wOffset = Tcl_LongAsWide((long) offset);
|
||||
wResult = Tcl_Seek(chan, wOffset, mode);
|
||||
return (int) Tcl_WideAsLong(wResult);
|
||||
}
|
||||
|
||||
int
|
||||
Tcl_TellOld(
|
||||
Tcl_Channel chan) /* The channel to return pos for. */
|
||||
{
|
||||
Tcl_WideInt wResult = Tcl_Tell(chan);
|
||||
|
||||
return (int) Tcl_WideAsLong(wResult);
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
@@ -9005,18 +8964,6 @@ ZeroTransferTimerProc(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCopyChannelOld(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
Tcl_Channel inChan, /* Channel to read from. */
|
||||
Tcl_Channel outChan, /* Channel to write to. */
|
||||
int toRead, /* Amount of data to copy, or -1 for all. */
|
||||
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
|
||||
{
|
||||
return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
|
||||
cmdPtr);
|
||||
}
|
||||
|
||||
int
|
||||
TclCopyChannel(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
|
||||
@@ -139,19 +139,6 @@ Tcl_PutsObjCmd(
|
||||
chanObjPtr = objv[2];
|
||||
string = objv[3];
|
||||
break;
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
|
||||
/*
|
||||
* The code below provides backwards compatibility with an old
|
||||
* form of the command that is no longer recommended or
|
||||
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
|
||||
* maybe even earlier.
|
||||
*/
|
||||
|
||||
chanObjPtr = objv[1];
|
||||
string = objv[2];
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
/* Fall through */
|
||||
default: /* [puts] or
|
||||
|
||||
@@ -410,22 +410,6 @@ Tcl_GetCwd(
|
||||
return Tcl_DStringValue(cwdPtr);
|
||||
}
|
||||
|
||||
/* Obsolete */
|
||||
int
|
||||
Tcl_EvalFile(
|
||||
Tcl_Interp *interp, /* Interpreter in which to process file. */
|
||||
const char *fileName) /* Name of file to process. Tilde-substitution
|
||||
* will be performed on this name. */
|
||||
{
|
||||
int ret;
|
||||
Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
|
||||
|
||||
Tcl_IncrRefCount(pathPtr);
|
||||
ret = Tcl_FSEvalFile(interp, pathPtr);
|
||||
Tcl_DecrRefCount(pathPtr);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now move on to the basic filesystem implementation.
|
||||
*/
|
||||
|
||||
+43
-40
@@ -51,10 +51,11 @@ declare 6 {
|
||||
declare 7 {
|
||||
int TclCopyAndCollapse(int count, const char *src, char *dst)
|
||||
}
|
||||
declare 8 {
|
||||
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
|
||||
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
|
||||
}
|
||||
# Removed in Tcl 9
|
||||
#declare 8 {
|
||||
# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
|
||||
# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
|
||||
#}
|
||||
|
||||
# TclCreatePipeline unofficially exported for use by BLT.
|
||||
|
||||
@@ -184,11 +185,11 @@ declare 41 {
|
||||
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
|
||||
}
|
||||
declare 42 {
|
||||
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
}
|
||||
# Removed in Tcl 8.5a2
|
||||
#declare 43 {
|
||||
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
|
||||
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
|
||||
# int flags)
|
||||
#}
|
||||
declare 44 {
|
||||
@@ -223,12 +224,12 @@ declare 51 {
|
||||
}
|
||||
# Removed in Tcl 8.5a2
|
||||
#declare 52 {
|
||||
# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
|
||||
# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
|
||||
# int flags)
|
||||
#}
|
||||
declare 53 {
|
||||
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
|
||||
int argc, CONST84 char **argv)
|
||||
int argc, const char **argv)
|
||||
}
|
||||
declare 54 {
|
||||
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
|
||||
@@ -315,10 +316,10 @@ declare 76 {
|
||||
unsigned long TclpGetSeconds(void)
|
||||
}
|
||||
|
||||
# deprecated
|
||||
declare 77 {
|
||||
void TclpGetTime(Tcl_Time *time)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 77 {
|
||||
# void TclpGetTime(Tcl_Time *time)
|
||||
#}
|
||||
# Removed in 8.6:
|
||||
#declare 78 {
|
||||
# int TclpGetTimeZone(unsigned long time)
|
||||
@@ -411,7 +412,7 @@ declare 98 {
|
||||
# Tcl_Obj *objPtr, int flags)
|
||||
#}
|
||||
declare 101 {
|
||||
CONST86 char *TclSetPreInitScript(const char *string)
|
||||
const char *TclSetPreInitScript(const char *string)
|
||||
}
|
||||
declare 102 {
|
||||
void TclSetupEnv(Tcl_Interp *interp)
|
||||
@@ -420,9 +421,10 @@ declare 103 {
|
||||
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
|
||||
int *portPtr)
|
||||
}
|
||||
declare 104 {
|
||||
int TclSockMinimumBuffersOld(int sock, int size)
|
||||
}
|
||||
# Removed in Tcl 9
|
||||
#declare 104 {
|
||||
# int TclSockMinimumBuffersOld(int sock, int size)
|
||||
#}
|
||||
# Replaced by Tcl_FSStat in 8.4:
|
||||
#declare 105 {
|
||||
# int TclStat(const char *path, Tcl_StatBuf *buf)
|
||||
@@ -533,9 +535,10 @@ declare 131 {
|
||||
declare 132 {
|
||||
int TclpHasSockets(Tcl_Interp *interp)
|
||||
}
|
||||
declare 133 {
|
||||
struct tm *TclpGetDate(const time_t *time, int useGMT)
|
||||
}
|
||||
# Removed in 9.0
|
||||
#declare 133 {
|
||||
# struct tm *TclpGetDate(const time_t *time, int useGMT)
|
||||
#}
|
||||
# Removed in 8.5
|
||||
#declare 134 {
|
||||
# size_t TclpStrftime(char *s, size_t maxsize, const char *format,
|
||||
@@ -551,7 +554,7 @@ declare 133 {
|
||||
# int TclpChdir(const char *dirName)
|
||||
#}
|
||||
declare 138 {
|
||||
CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
|
||||
const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
|
||||
}
|
||||
#declare 139 {
|
||||
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
|
||||
@@ -563,7 +566,7 @@ declare 138 {
|
||||
#}
|
||||
# This is used by TclX, but should otherwise be considered private
|
||||
declare 141 {
|
||||
CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
|
||||
const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
|
||||
}
|
||||
declare 142 {
|
||||
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
@@ -749,14 +752,14 @@ declare 177 {
|
||||
# const char *file, int line)
|
||||
#}
|
||||
|
||||
# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
|
||||
|
||||
declare 182 {
|
||||
struct tm *TclpLocaltime(const time_t *clock)
|
||||
}
|
||||
declare 183 {
|
||||
struct tm *TclpGmtime(const time_t *clock)
|
||||
}
|
||||
# Removed in 9.0
|
||||
#declare 182 {
|
||||
# struct tm *TclpLocaltime(const time_t *clock)
|
||||
#}
|
||||
# Removed in 9.0
|
||||
#declare 183 {
|
||||
# struct tm *TclpGmtime(const time_t *clock)
|
||||
#}
|
||||
|
||||
# For the new "Thread Storage" subsystem.
|
||||
|
||||
@@ -1020,9 +1023,10 @@ interface tclIntPlat
|
||||
declare 0 win {
|
||||
void TclWinConvertError(DWORD errCode)
|
||||
}
|
||||
declare 1 win {
|
||||
void TclWinConvertWSAError(DWORD errCode)
|
||||
}
|
||||
# Removed in Tcl 9.0
|
||||
#declare 1 win {
|
||||
# void TclWinConvertWSAError(DWORD errCode)
|
||||
#}
|
||||
declare 2 win {
|
||||
struct servent *TclWinGetServByName(const char *nm,
|
||||
const char *proto)
|
||||
@@ -1200,14 +1204,13 @@ declare 9 unix {
|
||||
declare 10 unix {
|
||||
Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
}
|
||||
# Slots 11 and 12 are forwarders for functions that were promoted to
|
||||
# generic Stubs
|
||||
declare 11 unix {
|
||||
struct tm *TclpLocaltime_unix(const time_t *clock)
|
||||
}
|
||||
declare 12 unix {
|
||||
struct tm *TclpGmtime_unix(const time_t *clock)
|
||||
}
|
||||
# Removed in Tcl 9.0
|
||||
#declare 11 unix {
|
||||
# struct tm *TclpLocaltime_unix(const time_t *clock)
|
||||
#}
|
||||
#declare 12 unix {
|
||||
# struct tm *TclpGmtime_unix(const time_t *clock)
|
||||
#}
|
||||
declare 13 unix {
|
||||
char *TclpInetNtoa(struct in_addr addr)
|
||||
}
|
||||
|
||||
+23
-55
@@ -152,13 +152,13 @@ typedef struct Tcl_ResolvedVarInfo {
|
||||
} Tcl_ResolvedVarInfo;
|
||||
|
||||
typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
|
||||
CONST84 char *name, int length, Tcl_Namespace *context,
|
||||
const char *name, int length, Tcl_Namespace *context,
|
||||
Tcl_ResolvedVarInfo **rPtr);
|
||||
|
||||
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
|
||||
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
|
||||
|
||||
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
|
||||
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
|
||||
|
||||
typedef struct Tcl_ResolverInfo {
|
||||
@@ -1799,42 +1799,33 @@ typedef struct AllocCache {
|
||||
*/
|
||||
|
||||
typedef struct Interp {
|
||||
|
||||
/*
|
||||
* Note: the first three fields must match exactly the fields in a
|
||||
* Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
|
||||
* other.
|
||||
*
|
||||
* The interpreter's result is held in both the string and the
|
||||
* objResultPtr fields. These fields hold, respectively, the result's
|
||||
* string or object value. The interpreter's result is always in the
|
||||
* result field if that is non-empty, otherwise it is in objResultPtr.
|
||||
* The two fields are kept consistent unless some C code sets
|
||||
* interp->result directly. Programs should not access result and
|
||||
* objResultPtr directly; instead, they should always get and set the
|
||||
* result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
|
||||
* Tcl_GetStringResult. See the SetResult man page for details.
|
||||
* The first two fields were named "result" and "freeProc" in earlier
|
||||
* versions of Tcl. They are no longer used within Tcl, and are no
|
||||
* longer available to be accessed by extensions. However, they cannot
|
||||
* be removed. Why? There is a deployed base of stub-enabled extensions
|
||||
* that query the value of iPtr->stubTable. For them to continue to work,
|
||||
* the location of the field "stubTable" within the Interp struct cannot
|
||||
* change. The most robust way to assure that is to leave all fields up to
|
||||
* that one undisturbed.
|
||||
*/
|
||||
|
||||
char *result; /* If the last command returned a string
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
Tcl_FreeProc *freeProc; /* Zero means a string result is statically
|
||||
* allocated. TCL_DYNAMIC means string result
|
||||
* was allocated with ckalloc and should be
|
||||
* freed with ckfree. Other values give
|
||||
* address of procedure to invoke to free the
|
||||
* string result. Tcl_Eval must free it before
|
||||
* executing next command. */
|
||||
char *legacyResult;
|
||||
Tcl_FreeProc *legacyFreeProc;
|
||||
int errorLine; /* When TCL_ERROR is returned, this gives the
|
||||
* line number in the command where the error
|
||||
* occurred (1 means first line). */
|
||||
const struct TclStubs *stubTable;
|
||||
/* Pointer to the exported Tcl stub table. On
|
||||
* previous versions of Tcl this is a pointer
|
||||
* to the objResultPtr or a pointer to a
|
||||
* buckets array in a hash table. We therefore
|
||||
* have to do some careful checking before we
|
||||
* can use this. */
|
||||
/* Pointer to the exported Tcl stub table. In
|
||||
* ancient pre-8.1 versions of Tcl this was a
|
||||
* pointer to the objResultPtr or a pointer to a
|
||||
* buckets array in a hash table. Deployed stubs
|
||||
* enabled extensions check for a NULL pointer value
|
||||
* and for a TCL_STUBS_MAGIC value to verify they
|
||||
* are not [load]ing into one of those pre-stubs
|
||||
* interps.
|
||||
*/
|
||||
|
||||
TclHandle handle; /* Handle used to keep track of when this
|
||||
* interp is deleted. */
|
||||
@@ -1847,8 +1838,6 @@ typedef struct Interp {
|
||||
ClientData interpInfo; /* Information used by tclInterp.c to keep
|
||||
* track of master/slave interps on a
|
||||
* per-interp basis. */
|
||||
Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */
|
||||
|
||||
/*
|
||||
* Information related to procedures and variables. See tclProc.c and
|
||||
* tclVar.c for usage.
|
||||
@@ -1877,19 +1866,6 @@ typedef struct Interp {
|
||||
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
|
||||
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
|
||||
|
||||
/*
|
||||
* Information used by Tcl_AppendResult to keep track of partial results.
|
||||
* See Tcl_AppendResult code for details.
|
||||
*/
|
||||
|
||||
char *appendResult; /* Storage space for results generated by
|
||||
* Tcl_AppendResult. Ckalloc-ed. NULL means
|
||||
* not yet allocated. */
|
||||
int appendAvl; /* Total amount of space available at
|
||||
* partialResult. */
|
||||
int appendUsed; /* Number of non-null bytes currently stored
|
||||
* at partialResult. */
|
||||
|
||||
/*
|
||||
* Information about packages. Used only in tclPkg.c.
|
||||
*/
|
||||
@@ -1912,7 +1888,6 @@ typedef struct Interp {
|
||||
* Normally zero, but may be set before
|
||||
* calling Tcl_Eval. See below for valid
|
||||
* values. */
|
||||
int unused1; /* No longer used (was termOffset) */
|
||||
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
|
||||
* objects holding literals of scripts
|
||||
* compiled by the interpreter. Indexed by the
|
||||
@@ -1950,8 +1925,6 @@ typedef struct Interp {
|
||||
* string. Returned by Tcl_ObjSetVar2 when
|
||||
* variable traces change a variable in a
|
||||
* gross way. */
|
||||
char resultSpace[TCL_RESULT_SIZE+1];
|
||||
/* Static space holding small results. */
|
||||
Tcl_Obj *objResultPtr; /* If the last command returned an object
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
@@ -2904,8 +2877,6 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
int strLen, const unsigned char *pattern,
|
||||
int ptnLen, int flags);
|
||||
MODULE_SCOPE double TclCeil(const mp_int *a);
|
||||
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
|
||||
const char *value);
|
||||
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
|
||||
@@ -3208,9 +3179,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
|
||||
+28
-44
@@ -69,10 +69,7 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
|
||||
/* 7 */
|
||||
EXTERN int TclCopyAndCollapse(int count, const char *src,
|
||||
char *dst);
|
||||
/* 8 */
|
||||
EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
|
||||
Tcl_Channel inChan, Tcl_Channel outChan,
|
||||
int toRead, Tcl_Obj *cmdPtr);
|
||||
/* Slot 8 is reserved */
|
||||
/* 9 */
|
||||
EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc,
|
||||
const char **argv, Tcl_Pid **pidArrayPtr,
|
||||
@@ -146,7 +143,7 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str,
|
||||
/* 41 */
|
||||
EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command);
|
||||
/* 42 */
|
||||
EXTERN CONST86 char * TclpGetUserHome(const char *name,
|
||||
EXTERN const char * TclpGetUserHome(const char *name,
|
||||
Tcl_DString *bufferPtr);
|
||||
/* Slot 43 is reserved */
|
||||
/* 44 */
|
||||
@@ -168,7 +165,7 @@ EXTERN int TclInterpInit(Tcl_Interp *interp);
|
||||
/* 53 */
|
||||
EXTERN int TclInvokeObjectCommand(ClientData clientData,
|
||||
Tcl_Interp *interp, int argc,
|
||||
CONST84 char **argv);
|
||||
const char **argv);
|
||||
/* 54 */
|
||||
EXTERN int TclInvokeStringCommand(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
@@ -212,8 +209,7 @@ EXTERN void TclpFree(char *ptr);
|
||||
EXTERN unsigned long TclpGetClicks(void);
|
||||
/* 76 */
|
||||
EXTERN unsigned long TclpGetSeconds(void);
|
||||
/* 77 */
|
||||
EXTERN void TclpGetTime(Tcl_Time *time);
|
||||
/* Slot 77 is reserved */
|
||||
/* Slot 78 is reserved */
|
||||
/* Slot 79 is reserved */
|
||||
/* Slot 80 is reserved */
|
||||
@@ -255,14 +251,13 @@ EXTERN int TclServiceIdle(void);
|
||||
/* Slot 99 is reserved */
|
||||
/* Slot 100 is reserved */
|
||||
/* 101 */
|
||||
EXTERN CONST86 char * TclSetPreInitScript(const char *string);
|
||||
EXTERN const char * TclSetPreInitScript(const char *string);
|
||||
/* 102 */
|
||||
EXTERN void TclSetupEnv(Tcl_Interp *interp);
|
||||
/* 103 */
|
||||
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
|
||||
const char *proto, int *portPtr);
|
||||
/* 104 */
|
||||
EXTERN int TclSockMinimumBuffersOld(int sock, int size);
|
||||
/* Slot 104 is reserved */
|
||||
/* Slot 105 is reserved */
|
||||
/* Slot 106 is reserved */
|
||||
/* Slot 107 is reserved */
|
||||
@@ -344,20 +339,17 @@ EXTERN void Tcl_SetNamespaceResolvers(
|
||||
Tcl_ResolveCompiledVarProc *compiledVarProc);
|
||||
/* 132 */
|
||||
EXTERN int TclpHasSockets(Tcl_Interp *interp);
|
||||
/* 133 */
|
||||
EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
|
||||
/* Slot 133 is reserved */
|
||||
/* Slot 134 is reserved */
|
||||
/* Slot 135 is reserved */
|
||||
/* Slot 136 is reserved */
|
||||
/* Slot 137 is reserved */
|
||||
/* 138 */
|
||||
EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
|
||||
Tcl_DString *valuePtr);
|
||||
EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr);
|
||||
/* Slot 139 is reserved */
|
||||
/* Slot 140 is reserved */
|
||||
/* 141 */
|
||||
EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
|
||||
Tcl_DString *cwdPtr);
|
||||
EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
|
||||
/* 142 */
|
||||
EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, CompileHookProc *hookProc,
|
||||
@@ -451,10 +443,8 @@ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
|
||||
/* Slot 179 is reserved */
|
||||
/* Slot 180 is reserved */
|
||||
/* Slot 181 is reserved */
|
||||
/* 182 */
|
||||
EXTERN struct tm * TclpLocaltime(const time_t *clock);
|
||||
/* 183 */
|
||||
EXTERN struct tm * TclpGmtime(const time_t *clock);
|
||||
/* Slot 182 is reserved */
|
||||
/* Slot 183 is reserved */
|
||||
/* Slot 184 is reserved */
|
||||
/* Slot 185 is reserved */
|
||||
/* Slot 186 is reserved */
|
||||
@@ -614,7 +604,7 @@ typedef struct TclIntStubs {
|
||||
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
|
||||
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
|
||||
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
|
||||
int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
|
||||
void (*reserved8)(void);
|
||||
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
|
||||
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
|
||||
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
|
||||
@@ -648,7 +638,7 @@ typedef struct TclIntStubs {
|
||||
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
|
||||
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
|
||||
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
|
||||
CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
|
||||
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
|
||||
void (*reserved43)(void);
|
||||
int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
|
||||
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
|
||||
@@ -659,7 +649,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
|
||||
int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
|
||||
void (*reserved52)(void);
|
||||
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
|
||||
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
|
||||
int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
|
||||
Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
|
||||
void (*reserved56)(void);
|
||||
@@ -683,7 +673,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclpFree) (char *ptr); /* 74 */
|
||||
unsigned long (*tclpGetClicks) (void); /* 75 */
|
||||
unsigned long (*tclpGetSeconds) (void); /* 76 */
|
||||
void (*tclpGetTime) (Tcl_Time *time); /* 77 */
|
||||
void (*reserved77)(void);
|
||||
void (*reserved78)(void);
|
||||
void (*reserved79)(void);
|
||||
void (*reserved80)(void);
|
||||
@@ -707,10 +697,10 @@ typedef struct TclIntStubs {
|
||||
int (*tclServiceIdle) (void); /* 98 */
|
||||
void (*reserved99)(void);
|
||||
void (*reserved100)(void);
|
||||
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
const char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
|
||||
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
|
||||
int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
|
||||
void (*reserved104)(void);
|
||||
void (*reserved105)(void);
|
||||
void (*reserved106)(void);
|
||||
void (*reserved107)(void);
|
||||
@@ -739,15 +729,15 @@ typedef struct TclIntStubs {
|
||||
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
|
||||
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
|
||||
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
|
||||
struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
|
||||
void (*reserved133)(void);
|
||||
void (*reserved134)(void);
|
||||
void (*reserved135)(void);
|
||||
void (*reserved136)(void);
|
||||
void (*reserved137)(void);
|
||||
CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
|
||||
const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
|
||||
void (*reserved139)(void);
|
||||
void (*reserved140)(void);
|
||||
CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
|
||||
const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
|
||||
int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
|
||||
int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
|
||||
void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
|
||||
@@ -788,8 +778,8 @@ typedef struct TclIntStubs {
|
||||
void (*reserved179)(void);
|
||||
void (*reserved180)(void);
|
||||
void (*reserved181)(void);
|
||||
struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
|
||||
struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
|
||||
void (*reserved182)(void);
|
||||
void (*reserved183)(void);
|
||||
void (*reserved184)(void);
|
||||
void (*reserved185)(void);
|
||||
void (*reserved186)(void);
|
||||
@@ -885,8 +875,7 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclCleanupCommand) /* 6 */
|
||||
#define TclCopyAndCollapse \
|
||||
(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
|
||||
#define TclCopyChannelOld \
|
||||
(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
|
||||
/* Slot 8 is reserved */
|
||||
#define TclCreatePipeline \
|
||||
(tclIntStubsPtr->tclCreatePipeline) /* 9 */
|
||||
#define TclCreateProc \
|
||||
@@ -993,8 +982,7 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclpGetClicks) /* 75 */
|
||||
#define TclpGetSeconds \
|
||||
(tclIntStubsPtr->tclpGetSeconds) /* 76 */
|
||||
#define TclpGetTime \
|
||||
(tclIntStubsPtr->tclpGetTime) /* 77 */
|
||||
/* Slot 77 is reserved */
|
||||
/* Slot 78 is reserved */
|
||||
/* Slot 79 is reserved */
|
||||
/* Slot 80 is reserved */
|
||||
@@ -1033,8 +1021,7 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclSetupEnv) /* 102 */
|
||||
#define TclSockGetPort \
|
||||
(tclIntStubsPtr->tclSockGetPort) /* 103 */
|
||||
#define TclSockMinimumBuffersOld \
|
||||
(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
|
||||
/* Slot 104 is reserved */
|
||||
/* Slot 105 is reserved */
|
||||
/* Slot 106 is reserved */
|
||||
/* Slot 107 is reserved */
|
||||
@@ -1088,8 +1075,7 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
|
||||
#define TclpHasSockets \
|
||||
(tclIntStubsPtr->tclpHasSockets) /* 132 */
|
||||
#define TclpGetDate \
|
||||
(tclIntStubsPtr->tclpGetDate) /* 133 */
|
||||
/* Slot 133 is reserved */
|
||||
/* Slot 134 is reserved */
|
||||
/* Slot 135 is reserved */
|
||||
/* Slot 136 is reserved */
|
||||
@@ -1168,10 +1154,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
/* Slot 179 is reserved */
|
||||
/* Slot 180 is reserved */
|
||||
/* Slot 181 is reserved */
|
||||
#define TclpLocaltime \
|
||||
(tclIntStubsPtr->tclpLocaltime) /* 182 */
|
||||
#define TclpGmtime \
|
||||
(tclIntStubsPtr->tclpGmtime) /* 183 */
|
||||
/* Slot 182 is reserved */
|
||||
/* Slot 183 is reserved */
|
||||
/* Slot 184 is reserved */
|
||||
/* Slot 185 is reserved */
|
||||
/* Slot 186 is reserved */
|
||||
|
||||
+15
-29
@@ -69,10 +69,8 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
@@ -102,8 +100,7 @@ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN void TclWinConvertError(DWORD errCode);
|
||||
/* 1 */
|
||||
EXTERN void TclWinConvertWSAError(DWORD errCode);
|
||||
/* Slot 1 is reserved */
|
||||
/* 2 */
|
||||
EXTERN struct servent * TclWinGetServByName(const char *nm,
|
||||
const char *proto);
|
||||
@@ -198,10 +195,8 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
@@ -260,8 +255,8 @@ typedef struct TclIntPlatStubs {
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
void (*reserved11)(void);
|
||||
void (*reserved12)(void);
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
void (*reserved15)(void);
|
||||
@@ -282,7 +277,7 @@ typedef struct TclIntPlatStubs {
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
void (*tclWinConvertError) (DWORD errCode); /* 0 */
|
||||
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
|
||||
void (*reserved1)(void);
|
||||
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
|
||||
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
|
||||
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
|
||||
@@ -324,8 +319,8 @@ typedef struct TclIntPlatStubs {
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
void (*reserved11)(void);
|
||||
void (*reserved12)(void);
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
|
||||
@@ -382,10 +377,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
@@ -411,8 +404,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#define TclWinConvertError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
|
||||
#define TclWinConvertWSAError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
|
||||
/* Slot 1 is reserved */
|
||||
#define TclWinGetServByName \
|
||||
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
|
||||
#define TclWinGetSockOpt \
|
||||
@@ -490,10 +482,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
@@ -528,10 +518,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
#undef TclpLocaltime_unix
|
||||
#undef TclpGmtime_unix
|
||||
#undef TclWinConvertWSAError
|
||||
#define TclWinConvertWSAError TclWinConvertError
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__)
|
||||
# undef TclWinNToHS
|
||||
|
||||
+12
-2
@@ -463,14 +463,24 @@ Tcl_LoadObjCmd(
|
||||
}
|
||||
code = pkgPtr->initProc(target);
|
||||
}
|
||||
|
||||
/*
|
||||
* Test for whether the initialization failed. If so, transfer the error
|
||||
* from the target interpreter to the originating one.
|
||||
*/
|
||||
|
||||
if (code != TCL_OK) {
|
||||
Tcl_TransferResult(target, code, interp);
|
||||
Interp *iPtr = (Interp *) target;
|
||||
if (iPtr->legacyResult != NULL) {
|
||||
/*
|
||||
* A call to Tcl_InitStubs() determined the caller extension and
|
||||
* this interp are incompatible in their stubs mechanisms, and
|
||||
* recorded the error in the oldest legacy place we have to do so.
|
||||
*/
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(iPtr->legacyResult, -1));
|
||||
iPtr->legacyResult = NULL;
|
||||
} else {
|
||||
Tcl_TransferResult(target, code, interp);
|
||||
}
|
||||
goto done;
|
||||
}
|
||||
|
||||
|
||||
+6
-2
@@ -243,7 +243,7 @@ Tcl_SourceRCFile(
|
||||
const char *fileName;
|
||||
Tcl_Channel chan;
|
||||
|
||||
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
|
||||
fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY);
|
||||
if (fileName != NULL) {
|
||||
Tcl_Channel c;
|
||||
const char *fullName;
|
||||
@@ -263,14 +263,18 @@ Tcl_SourceRCFile(
|
||||
|
||||
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
|
||||
if (c != NULL) {
|
||||
Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1);
|
||||
|
||||
Tcl_Close(NULL, c);
|
||||
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
|
||||
Tcl_IncrRefCount(fullNameObj);
|
||||
if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) {
|
||||
chan = Tcl_GetStdChannel(TCL_STDERR);
|
||||
if (chan) {
|
||||
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
|
||||
Tcl_WriteChars(chan, "\n", 1);
|
||||
}
|
||||
}
|
||||
Tcl_DecrRefCount(fullNameObj);
|
||||
}
|
||||
}
|
||||
Tcl_DStringFree(&temp);
|
||||
|
||||
+26
-318
@@ -27,7 +27,6 @@ enum returnKeys {
|
||||
static Tcl_Obj ** GetKeys(void);
|
||||
static void ReleaseKeys(ClientData clientData);
|
||||
static void ResetObjResult(Interp *iPtr);
|
||||
static void SetupAppendBuffer(Interp *iPtr, int newSpace);
|
||||
|
||||
/*
|
||||
* This structure is used to take a snapshot of the interpreter state in
|
||||
@@ -246,44 +245,6 @@ Tcl_SaveResult(
|
||||
statePtr->objResultPtr = iPtr->objResultPtr;
|
||||
iPtr->objResultPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(iPtr->objResultPtr);
|
||||
|
||||
/*
|
||||
* Save the string result.
|
||||
*/
|
||||
|
||||
statePtr->freeProc = iPtr->freeProc;
|
||||
if (iPtr->result == iPtr->resultSpace) {
|
||||
/*
|
||||
* Copy the static string data out of the interp buffer.
|
||||
*/
|
||||
|
||||
statePtr->result = statePtr->resultSpace;
|
||||
strcpy(statePtr->result, iPtr->result);
|
||||
statePtr->appendResult = NULL;
|
||||
} else if (iPtr->result == iPtr->appendResult) {
|
||||
/*
|
||||
* Move the append buffer out of the interp.
|
||||
*/
|
||||
|
||||
statePtr->appendResult = iPtr->appendResult;
|
||||
statePtr->appendAvl = iPtr->appendAvl;
|
||||
statePtr->appendUsed = iPtr->appendUsed;
|
||||
statePtr->result = statePtr->appendResult;
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
iPtr->appendUsed = 0;
|
||||
} else {
|
||||
/*
|
||||
* Move the dynamic or static string out of the interpreter.
|
||||
*/
|
||||
|
||||
statePtr->result = iPtr->result;
|
||||
statePtr->appendResult = NULL;
|
||||
}
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -313,39 +274,6 @@ Tcl_RestoreResult(
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
/*
|
||||
* Restore the string result.
|
||||
*/
|
||||
|
||||
iPtr->freeProc = statePtr->freeProc;
|
||||
if (statePtr->result == statePtr->resultSpace) {
|
||||
/*
|
||||
* Copy the static string data into the interp buffer.
|
||||
*/
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
strcpy(iPtr->result, statePtr->result);
|
||||
} else if (statePtr->result == statePtr->appendResult) {
|
||||
/*
|
||||
* Move the append buffer back into the interp.
|
||||
*/
|
||||
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
}
|
||||
|
||||
iPtr->appendResult = statePtr->appendResult;
|
||||
iPtr->appendAvl = statePtr->appendAvl;
|
||||
iPtr->appendUsed = statePtr->appendUsed;
|
||||
iPtr->result = iPtr->appendResult;
|
||||
} else {
|
||||
/*
|
||||
* Move the dynamic or static string back into the interpreter.
|
||||
*/
|
||||
|
||||
iPtr->result = statePtr->result;
|
||||
}
|
||||
|
||||
/*
|
||||
* Restore the object result.
|
||||
*/
|
||||
@@ -377,14 +305,6 @@ Tcl_DiscardResult(
|
||||
Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
|
||||
{
|
||||
TclDecrRefCount(statePtr->objResultPtr);
|
||||
|
||||
if (statePtr->result == statePtr->appendResult) {
|
||||
ckfree(statePtr->appendResult);
|
||||
} else if (statePtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(statePtr->result);
|
||||
} else if (statePtr->freeProc) {
|
||||
statePtr->freeProc(statePtr->result);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -414,49 +334,15 @@ Tcl_SetResult(
|
||||
* TCL_STATIC, TCL_VOLATILE, or the address of
|
||||
* a Tcl_FreeProc such as free. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
|
||||
char *oldResult = iPtr->result;
|
||||
|
||||
if (result == NULL) {
|
||||
iPtr->resultSpace[0] = 0;
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->freeProc = 0;
|
||||
} else if (freeProc == TCL_VOLATILE) {
|
||||
int length = strlen(result);
|
||||
|
||||
if (length > TCL_RESULT_SIZE) {
|
||||
iPtr->result = ckalloc(length + 1);
|
||||
iPtr->freeProc = TCL_DYNAMIC;
|
||||
} else {
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
memcpy(iPtr->result, result, (unsigned) length+1);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
|
||||
if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
|
||||
return;
|
||||
}
|
||||
if (freeProc == TCL_DYNAMIC) {
|
||||
ckfree(result);
|
||||
} else {
|
||||
iPtr->result = (char *) result;
|
||||
iPtr->freeProc = freeProc;
|
||||
(*freeProc)(result);
|
||||
}
|
||||
|
||||
/*
|
||||
* If the old result was dynamically-allocated, free it up. Do it here,
|
||||
* rather than at the beginning, in case the new result value was part of
|
||||
* the old result value.
|
||||
*/
|
||||
|
||||
if (oldFreeProc != 0) {
|
||||
if (oldFreeProc == TCL_DYNAMIC) {
|
||||
ckfree(oldResult);
|
||||
} else {
|
||||
oldFreeProc(oldResult);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Reset the object result since we just set the string result.
|
||||
*/
|
||||
|
||||
ResetObjResult(iPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -480,18 +366,9 @@ const char *
|
||||
Tcl_GetStringResult(
|
||||
register Tcl_Interp *interp)/* Interpreter whose result to return. */
|
||||
{
|
||||
/*
|
||||
* If the string result is empty, move the object result to the string
|
||||
* result, then reset the object result.
|
||||
*/
|
||||
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (*(iPtr->result) == 0) {
|
||||
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
|
||||
TCL_VOLATILE);
|
||||
}
|
||||
return iPtr->result;
|
||||
return Tcl_GetString(iPtr->objResultPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -532,21 +409,6 @@ Tcl_SetObjResult(
|
||||
*/
|
||||
|
||||
TclDecrRefCount(oldObjResult);
|
||||
|
||||
/*
|
||||
* Reset the string result since we just set the result object.
|
||||
*/
|
||||
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -575,32 +437,7 @@ Tcl_GetObjResult(
|
||||
Tcl_Interp *interp) /* Interpreter whose result to return. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *objResultPtr;
|
||||
int length;
|
||||
|
||||
/*
|
||||
* If the string result is non-empty, move the string result to the object
|
||||
* result, then reset the string result.
|
||||
*/
|
||||
|
||||
if (iPtr->result[0] != 0) {
|
||||
ResetObjResult(iPtr);
|
||||
|
||||
objResultPtr = iPtr->objResultPtr;
|
||||
length = strlen(iPtr->result);
|
||||
TclInitStringRep(objResultPtr, iPtr->result, length);
|
||||
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->result[0] = 0;
|
||||
}
|
||||
return iPtr->objResultPtr;
|
||||
}
|
||||
|
||||
@@ -719,129 +556,20 @@ Tcl_AppendElement(
|
||||
* to result. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
char *dst;
|
||||
int size;
|
||||
int flags;
|
||||
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
|
||||
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
|
||||
int length;
|
||||
const char *bytes;
|
||||
|
||||
/*
|
||||
* If the string result is empty, move the object result to the string
|
||||
* result, then reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
/*
|
||||
* See how much space is needed, and grow the append buffer if needed to
|
||||
* accommodate the list element.
|
||||
*/
|
||||
|
||||
size = Tcl_ScanElement(element, &flags) + 1;
|
||||
if ((iPtr->result != iPtr->appendResult)
|
||||
|| (iPtr->appendResult[iPtr->appendUsed] != 0)
|
||||
|| ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
|
||||
SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
|
||||
if (Tcl_IsShared(iPtr->objResultPtr)) {
|
||||
Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
|
||||
}
|
||||
bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
|
||||
if (TclNeedSpace(bytes, bytes+length)) {
|
||||
Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert the string into a list element and copy it to the buffer that's
|
||||
* forming, with a space separator if needed.
|
||||
*/
|
||||
|
||||
dst = iPtr->appendResult + iPtr->appendUsed;
|
||||
if (TclNeedSpace(iPtr->appendResult, dst)) {
|
||||
iPtr->appendUsed++;
|
||||
*dst = ' ';
|
||||
dst++;
|
||||
|
||||
/*
|
||||
* If we need a space to separate this element from preceding stuff,
|
||||
* then this element will not lead a list, and need not have it's
|
||||
* leading '#' quoted.
|
||||
*/
|
||||
|
||||
flags |= TCL_DONT_QUOTE_HASH;
|
||||
}
|
||||
iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* SetupAppendBuffer --
|
||||
*
|
||||
* This function makes sure that there is an append buffer properly
|
||||
* initialized, if necessary, from the interpreter's result, and that it
|
||||
* has at least enough room to accommodate newSpace new bytes of
|
||||
* information.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
SetupAppendBuffer(
|
||||
Interp *iPtr, /* Interpreter whose result is being set up. */
|
||||
int newSpace) /* Make sure that at least this many bytes of
|
||||
* new information may be added. */
|
||||
{
|
||||
int totalSpace;
|
||||
|
||||
/*
|
||||
* Make the append buffer larger, if that's necessary, then copy the
|
||||
* result into the append buffer and make the append buffer the official
|
||||
* Tcl result.
|
||||
*/
|
||||
|
||||
if (iPtr->result != iPtr->appendResult) {
|
||||
/*
|
||||
* If an oversized buffer was used recently, then free it up so we go
|
||||
* back to a smaller buffer. This avoids tying up memory forever after
|
||||
* a large operation.
|
||||
*/
|
||||
|
||||
if (iPtr->appendAvl > 500) {
|
||||
ckfree(iPtr->appendResult);
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
}
|
||||
iPtr->appendUsed = strlen(iPtr->result);
|
||||
} else if (iPtr->result[iPtr->appendUsed] != 0) {
|
||||
/*
|
||||
* Most likely someone has modified a result created by
|
||||
* Tcl_AppendResult et al. so that it has a different size. Just
|
||||
* recompute the size.
|
||||
*/
|
||||
|
||||
iPtr->appendUsed = strlen(iPtr->result);
|
||||
}
|
||||
|
||||
totalSpace = newSpace + iPtr->appendUsed;
|
||||
if (totalSpace >= iPtr->appendAvl) {
|
||||
char *new;
|
||||
|
||||
if (totalSpace < 100) {
|
||||
totalSpace = 200;
|
||||
} else {
|
||||
totalSpace *= 2;
|
||||
}
|
||||
new = ckalloc(totalSpace);
|
||||
strcpy(new, iPtr->result);
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
}
|
||||
iPtr->appendResult = new;
|
||||
iPtr->appendAvl = totalSpace;
|
||||
} else if (iPtr->result != iPtr->appendResult) {
|
||||
strcpy(iPtr->appendResult, iPtr->result);
|
||||
}
|
||||
|
||||
Tcl_FreeResult((Tcl_Interp *) iPtr);
|
||||
iPtr->result = iPtr->appendResult;
|
||||
Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -850,18 +578,17 @@ SetupAppendBuffer(
|
||||
* Tcl_FreeResult --
|
||||
*
|
||||
* This function frees up the memory associated with an interpreter's
|
||||
* string result. It also resets the interpreter's result object.
|
||||
* Tcl_FreeResult is most commonly used when a function is about to
|
||||
* replace one result value with another.
|
||||
* result, resetting the interpreter's result object. Tcl_FreeResult is
|
||||
* most commonly used when a function is about to replace one result
|
||||
* value with another.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Frees the memory associated with interp's string result and sets
|
||||
* interp->freeProc to zero, but does not change interp->result or clear
|
||||
* error state. Resets interp's result object to an unshared empty
|
||||
* object.
|
||||
* Frees the memory associated with interp's result but does not change
|
||||
* any part of the error dictionary (i.e., the errorinfo and errorcode
|
||||
* remain the same).
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -872,15 +599,6 @@ Tcl_FreeResult(
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
|
||||
ResetObjResult(iPtr);
|
||||
}
|
||||
|
||||
@@ -910,16 +628,6 @@ Tcl_ResetResult(
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
|
||||
ResetObjResult(iPtr);
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
if (iPtr->errorCode) {
|
||||
/* Legacy support */
|
||||
if (iPtr->flags & ERR_LEGACY_COPY) {
|
||||
|
||||
+1
-71
@@ -17,13 +17,6 @@
|
||||
#include "tommath.h"
|
||||
#include <math.h>
|
||||
|
||||
/*
|
||||
* Define KILL_OCTAL to suppress interpretation of numbers with leading zero
|
||||
* as octal. (Ceterum censeo: numeros octonarios delendos esse.)
|
||||
*/
|
||||
|
||||
#undef KILL_OCTAL
|
||||
|
||||
/*
|
||||
* This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
|
||||
* floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
|
||||
@@ -487,7 +480,7 @@ TclParseNumber(
|
||||
enum State {
|
||||
INITIAL, SIGNUM, ZERO, ZERO_X,
|
||||
ZERO_O, ZERO_B, BINARY,
|
||||
HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
|
||||
HEXADECIMAL, OCTAL, DECIMAL,
|
||||
LEADING_RADIX_POINT, FRACTION,
|
||||
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
|
||||
sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
|
||||
@@ -532,7 +525,6 @@ TclParseNumber(
|
||||
char d = 0; /* Last hexadecimal digit scanned; initialized
|
||||
* to avoid a compiler warning. */
|
||||
int shift = 0; /* Amount to shift when accumulating binary */
|
||||
int explicitOctal = 0;
|
||||
|
||||
#define ALL_BITS (~(Tcl_WideUInt)0)
|
||||
#define MOST_BITS (ALL_BITS >> 1)
|
||||
@@ -644,14 +636,10 @@ TclParseNumber(
|
||||
goto zerob;
|
||||
}
|
||||
if (c == 'o' || c == 'O') {
|
||||
explicitOctal = 1;
|
||||
state = ZERO_O;
|
||||
break;
|
||||
}
|
||||
#ifdef KILL_OCTAL
|
||||
goto decimal;
|
||||
#endif
|
||||
/* FALLTHROUGH */
|
||||
|
||||
case OCTAL:
|
||||
/*
|
||||
@@ -714,58 +702,6 @@ TclParseNumber(
|
||||
state = OCTAL;
|
||||
break;
|
||||
}
|
||||
/* FALLTHROUGH */
|
||||
|
||||
case BAD_OCTAL:
|
||||
if (explicitOctal) {
|
||||
/*
|
||||
* No forgiveness for bad digits in explicitly octal numbers.
|
||||
*/
|
||||
|
||||
goto endgame;
|
||||
}
|
||||
if (flags & TCL_PARSE_INTEGER_ONLY) {
|
||||
/*
|
||||
* No seeking floating point when parsing only integer.
|
||||
*/
|
||||
|
||||
goto endgame;
|
||||
}
|
||||
#ifndef KILL_OCTAL
|
||||
|
||||
/*
|
||||
* Scanned a number with a leading zero that contains an 8, 9,
|
||||
* radix point or E. This is an invalid octal number, but might
|
||||
* still be floating point.
|
||||
*/
|
||||
|
||||
if (c == '0') {
|
||||
numTrailZeros++;
|
||||
state = BAD_OCTAL;
|
||||
break;
|
||||
} else if (isdigit(UCHAR(c))) {
|
||||
if (objPtr != NULL) {
|
||||
significandOverflow = AccumulateDecimalDigit(
|
||||
(unsigned)(c-'0'), numTrailZeros,
|
||||
&significandWide, &significandBig,
|
||||
significandOverflow);
|
||||
}
|
||||
if (numSigDigs != 0) {
|
||||
numSigDigs += (numTrailZeros + 1);
|
||||
} else {
|
||||
numSigDigs = 1;
|
||||
}
|
||||
numTrailZeros = 0;
|
||||
state = BAD_OCTAL;
|
||||
break;
|
||||
} else if (c == '.') {
|
||||
state = FRACTION;
|
||||
break;
|
||||
} else if (c == 'E' || c == 'e') {
|
||||
state = EXPONENT_START;
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
goto endgame;
|
||||
|
||||
/*
|
||||
@@ -870,9 +806,7 @@ TclParseNumber(
|
||||
* digits.
|
||||
*/
|
||||
|
||||
#ifdef KILL_OCTAL
|
||||
decimal:
|
||||
#endif
|
||||
acceptState = state;
|
||||
acceptPoint = p;
|
||||
acceptLen = len;
|
||||
@@ -1156,7 +1090,6 @@ TclParseNumber(
|
||||
TclFreeIntRep(objPtr);
|
||||
switch (acceptState) {
|
||||
case SIGNUM:
|
||||
case BAD_OCTAL:
|
||||
case ZERO_X:
|
||||
case ZERO_O:
|
||||
case ZERO_B:
|
||||
@@ -1381,9 +1314,6 @@ TclParseNumber(
|
||||
|
||||
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
|
||||
Tcl_AppendToObj(msg, "\"", -1);
|
||||
if (state == BAD_OCTAL) {
|
||||
Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
|
||||
}
|
||||
Tcl_SetObjResult(interp, msg);
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
|
||||
}
|
||||
|
||||
+22
-37
@@ -42,18 +42,6 @@
|
||||
#undef TclpGetPid
|
||||
#undef TclSockMinimumBuffers
|
||||
|
||||
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
|
||||
#ifdef _WIN64
|
||||
# define TclSockMinimumBuffersOld 0
|
||||
#else
|
||||
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
|
||||
static int TclSockMinimumBuffersOld(int sock, int size)
|
||||
{
|
||||
return TclSockMinimumBuffers(INT2PTR(sock), size);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||
#undef TclWinNToHS
|
||||
#define TclWinNToHS winNToHS
|
||||
@@ -169,9 +157,6 @@ Tcl_WinTCharToUtf(
|
||||
string, len, dsPtr);
|
||||
}
|
||||
|
||||
#else /* UNIX and MAC */
|
||||
# define TclpLocaltime_unix TclpLocaltime
|
||||
# define TclpGmtime_unix TclpGmtime
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -196,7 +181,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclCleanupChildren, /* 5 */
|
||||
TclCleanupCommand, /* 6 */
|
||||
TclCopyAndCollapse, /* 7 */
|
||||
TclCopyChannelOld, /* 8 */
|
||||
0, /* 8 */
|
||||
TclCreatePipeline, /* 9 */
|
||||
TclCreateProc, /* 10 */
|
||||
TclDeleteCompiledLocalVars, /* 11 */
|
||||
@@ -265,7 +250,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclpFree, /* 74 */
|
||||
TclpGetClicks, /* 75 */
|
||||
TclpGetSeconds, /* 76 */
|
||||
TclpGetTime, /* 77 */
|
||||
0, /* 77 */
|
||||
0, /* 78 */
|
||||
0, /* 79 */
|
||||
0, /* 80 */
|
||||
@@ -292,7 +277,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclSetPreInitScript, /* 101 */
|
||||
TclSetupEnv, /* 102 */
|
||||
TclSockGetPort, /* 103 */
|
||||
TclSockMinimumBuffersOld, /* 104 */
|
||||
0, /* 104 */
|
||||
0, /* 105 */
|
||||
0, /* 106 */
|
||||
0, /* 107 */
|
||||
@@ -321,7 +306,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
Tcl_RemoveInterpResolvers, /* 130 */
|
||||
Tcl_SetNamespaceResolvers, /* 131 */
|
||||
TclpHasSockets, /* 132 */
|
||||
TclpGetDate, /* 133 */
|
||||
0, /* 133 */
|
||||
0, /* 134 */
|
||||
0, /* 135 */
|
||||
0, /* 136 */
|
||||
@@ -370,8 +355,8 @@ static const TclIntStubs tclIntStubs = {
|
||||
0, /* 179 */
|
||||
0, /* 180 */
|
||||
0, /* 181 */
|
||||
TclpLocaltime, /* 182 */
|
||||
TclpGmtime, /* 183 */
|
||||
0, /* 182 */
|
||||
0, /* 183 */
|
||||
0, /* 184 */
|
||||
0, /* 185 */
|
||||
0, /* 186 */
|
||||
@@ -456,8 +441,8 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TclUnixWaitForFile, /* 8 */
|
||||
TclpCreateTempFile, /* 9 */
|
||||
TclpReaddir, /* 10 */
|
||||
TclpLocaltime_unix, /* 11 */
|
||||
TclpGmtime_unix, /* 12 */
|
||||
0, /* 11 */
|
||||
0, /* 12 */
|
||||
TclpInetNtoa, /* 13 */
|
||||
TclUnixCopyFile, /* 14 */
|
||||
0, /* 15 */
|
||||
@@ -478,7 +463,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
TclWinConvertError, /* 0 */
|
||||
TclWinConvertWSAError, /* 1 */
|
||||
0, /* 1 */
|
||||
TclWinGetServByName, /* 2 */
|
||||
TclWinGetSockOpt, /* 3 */
|
||||
TclWinGetTclInstance, /* 4 */
|
||||
@@ -520,8 +505,8 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TclUnixWaitForFile, /* 8 */
|
||||
TclpCreateTempFile, /* 9 */
|
||||
TclpReaddir, /* 10 */
|
||||
TclpLocaltime_unix, /* 11 */
|
||||
TclpGmtime_unix, /* 12 */
|
||||
0, /* 11 */
|
||||
0, /* 12 */
|
||||
TclpInetNtoa, /* 13 */
|
||||
TclUnixCopyFile, /* 14 */
|
||||
TclMacOSXGetFileAttribute, /* 15 */
|
||||
@@ -726,7 +711,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_AsyncMark, /* 74 */
|
||||
Tcl_AsyncReady, /* 75 */
|
||||
Tcl_BackgroundError, /* 76 */
|
||||
Tcl_Backslash, /* 77 */
|
||||
0, /* 77 */
|
||||
Tcl_BadChannelOption, /* 78 */
|
||||
Tcl_CallWhenDeleted, /* 79 */
|
||||
Tcl_CancelIdleCall, /* 80 */
|
||||
@@ -744,7 +729,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_CreateEventSource, /* 92 */
|
||||
Tcl_CreateExitHandler, /* 93 */
|
||||
Tcl_CreateInterp, /* 94 */
|
||||
Tcl_CreateMathFunc, /* 95 */
|
||||
0, /* 95 */
|
||||
Tcl_CreateObjCommand, /* 96 */
|
||||
Tcl_CreateSlave, /* 97 */
|
||||
Tcl_CreateTimerHandler, /* 98 */
|
||||
@@ -779,7 +764,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_ErrnoId, /* 127 */
|
||||
Tcl_ErrnoMsg, /* 128 */
|
||||
Tcl_Eval, /* 129 */
|
||||
Tcl_EvalFile, /* 130 */
|
||||
0, /* 130 */
|
||||
Tcl_EvalObj, /* 131 */
|
||||
Tcl_EventuallyFree, /* 132 */
|
||||
Tcl_Exit, /* 133 */
|
||||
@@ -793,7 +778,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_ExprObj, /* 141 */
|
||||
Tcl_ExprString, /* 142 */
|
||||
Tcl_Finalize, /* 143 */
|
||||
Tcl_FindExecutable, /* 144 */
|
||||
0, /* 144 */
|
||||
Tcl_FirstHashEntry, /* 145 */
|
||||
Tcl_Flush, /* 146 */
|
||||
Tcl_FreeResult, /* 147 */
|
||||
@@ -834,8 +819,8 @@ const TclStubs tclStubs = {
|
||||
Tcl_GetStringResult, /* 174 */
|
||||
Tcl_GetVar, /* 175 */
|
||||
Tcl_GetVar2, /* 176 */
|
||||
Tcl_GlobalEval, /* 177 */
|
||||
Tcl_GlobalEvalObj, /* 178 */
|
||||
0, /* 177 */
|
||||
0, /* 178 */
|
||||
Tcl_HideCommand, /* 179 */
|
||||
Tcl_Init, /* 180 */
|
||||
Tcl_InitHashTable, /* 181 */
|
||||
@@ -877,7 +862,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_ResetResult, /* 217 */
|
||||
Tcl_ScanElement, /* 218 */
|
||||
Tcl_ScanCountedElement, /* 219 */
|
||||
Tcl_SeekOld, /* 220 */
|
||||
0, /* 220 */
|
||||
Tcl_ServiceAll, /* 221 */
|
||||
Tcl_ServiceEvent, /* 222 */
|
||||
Tcl_SetAssocData, /* 223 */
|
||||
@@ -903,7 +888,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_SplitPath, /* 243 */
|
||||
Tcl_StaticPackage, /* 244 */
|
||||
Tcl_StringMatch, /* 245 */
|
||||
Tcl_TellOld, /* 246 */
|
||||
0, /* 246 */
|
||||
Tcl_TraceVar, /* 247 */
|
||||
Tcl_TraceVar2, /* 248 */
|
||||
Tcl_TranslateFileName, /* 249 */
|
||||
@@ -1014,7 +999,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_UniCharToUtfDString, /* 354 */
|
||||
Tcl_UtfToUniCharDString, /* 355 */
|
||||
Tcl_GetRegExpFromObj, /* 356 */
|
||||
Tcl_EvalTokens, /* 357 */
|
||||
0, /* 357 */
|
||||
Tcl_FreeParse, /* 358 */
|
||||
Tcl_LogCommandInfo, /* 359 */
|
||||
Tcl_ParseBraces, /* 360 */
|
||||
@@ -1092,8 +1077,8 @@ const TclStubs tclStubs = {
|
||||
Tcl_AttemptSetObjLength, /* 432 */
|
||||
Tcl_GetChannelThread, /* 433 */
|
||||
Tcl_GetUnicodeFromObj, /* 434 */
|
||||
Tcl_GetMathFuncInfo, /* 435 */
|
||||
Tcl_ListMathFuncs, /* 436 */
|
||||
0, /* 435 */
|
||||
0, /* 436 */
|
||||
Tcl_SubstObj, /* 437 */
|
||||
Tcl_DetachChannel, /* 438 */
|
||||
Tcl_IsStandardChannel, /* 439 */
|
||||
|
||||
+77
-7
@@ -41,8 +41,35 @@ HasStubSupport(
|
||||
if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
|
||||
return iPtr->stubTable;
|
||||
}
|
||||
iPtr->result = (char *) "interpreter uses an incompatible stubs mechanism";
|
||||
iPtr->freeProc = TCL_STATIC;
|
||||
|
||||
/*
|
||||
* Either interp has no stubTable field, or its magic number has been
|
||||
* changed, indicating a release of Tcl that no longer supports the
|
||||
* stubs mechanism with which the extension has been prepared. This
|
||||
* either means interp comes from Tcl releases 7.5 - 8.0, when [load]
|
||||
* of extensions was possible, but stubs were not yet in use, or it means
|
||||
* interp come from some future release of Tcl where it has been necessary
|
||||
* to stop supporting this particular stubs mechanism. In either case,
|
||||
* we can count on the fields legacyResult and legacyFreeProc existing
|
||||
* (since they persist to maintain the struct offset fo stubTable; see
|
||||
* tclInt.h comments.), and we can hope that [load] or any sensible
|
||||
* successor will be able to reach into them to report the mismatch error
|
||||
* message sensibly.
|
||||
*
|
||||
* For maximum compat support, even if only for the sake of reporting
|
||||
* clean errors, rather than crashing, we assume the TCL_STUB_MAGIC
|
||||
* value is changed only when absolutely necessary. So long as the first
|
||||
* slot in the stub table holds (some function compatible with) the routine
|
||||
* Tcl_PkgRequireEx(), that routine can take care of verifying the version
|
||||
* compatibility testing with all deployed stubs-enabled extensions. That is,
|
||||
* there is no need to change the value of TCL_STUB_MAGIC when transitioning
|
||||
* from the Tcl 8 stubs table to the Tcl 9 stubs table, so long as they
|
||||
* share just their first slot in common.
|
||||
*/
|
||||
|
||||
iPtr->legacyResult
|
||||
= (char *) "interpreter uses an incompatible stubs mechanism";
|
||||
iPtr->legacyFreeProc = TCL_STATIC;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
@@ -58,7 +85,7 @@ static int isDigit(const int c)
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_InitStubs --
|
||||
* TclInitStubs --
|
||||
*
|
||||
* Tries to initialise the stub table pointers and ensures that the
|
||||
* correct version of Tcl is loaded.
|
||||
@@ -74,13 +101,56 @@ static int isDigit(const int c)
|
||||
*/
|
||||
|
||||
MODULE_SCOPE const char *
|
||||
Tcl_InitStubs(
|
||||
TclInitStubs(
|
||||
Tcl_Interp *interp,
|
||||
const char *version,
|
||||
int exact)
|
||||
int exact,
|
||||
int major,
|
||||
int magic)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
const char *actualVersion = NULL;
|
||||
ClientData pkgData = NULL;
|
||||
const char *p, *q;
|
||||
|
||||
/*
|
||||
* Detect whether the extension and the stubs library were built
|
||||
* against Tcl header files declaring use of incompatible stubs
|
||||
* mechanisms. Even within the same mechanism, also detect if
|
||||
* the header files are from different major versions. Either
|
||||
* is seriously broken. An extension and its stubs library ought
|
||||
* to share compatible headers, if not the same one.
|
||||
*/
|
||||
|
||||
if (magic != TCL_STUB_MAGIC || major != TCL_MAJOR_VERSION) {
|
||||
iPtr->legacyResult =
|
||||
(char *) "extension linked to incompatible stubs library";
|
||||
iPtr->legacyFreeProc = TCL_STATIC;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Detect whether an extension compiled against a Tcl header file
|
||||
* of one major version is requesting to use a stubs table of a
|
||||
* different major version. According to our compat rules, that's
|
||||
* a request that cannot succeed. Different major versions imply
|
||||
* incompatible stub tables.
|
||||
*/
|
||||
|
||||
p = version;
|
||||
q = TCL_VERSION;
|
||||
while (isDigit(*p)) {
|
||||
if (*p++ != *q++) {
|
||||
goto badVersion;
|
||||
}
|
||||
}
|
||||
if (isDigit(*q)) {
|
||||
badVersion:
|
||||
iPtr->legacyResult =
|
||||
(char *) "extension passed bad version argument to stubs library";
|
||||
iPtr->legacyFreeProc = TCL_STATIC;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* We can't optimize this check by caching tclStubsPtr because that
|
||||
@@ -98,14 +168,14 @@ Tcl_InitStubs(
|
||||
return NULL;
|
||||
}
|
||||
if (exact) {
|
||||
const char *p = version;
|
||||
int count = 0;
|
||||
|
||||
p = version;
|
||||
while (*p) {
|
||||
count += !isDigit(*p++);
|
||||
}
|
||||
if (count == 1) {
|
||||
const char *q = actualVersion;
|
||||
q = actualVersion;
|
||||
|
||||
p = version;
|
||||
while (*p && (*p == *q)) {
|
||||
|
||||
+11
-175
@@ -115,13 +115,6 @@ typedef struct TclEncoding {
|
||||
char *fromUtfCmd;
|
||||
} TclEncoding;
|
||||
|
||||
/*
|
||||
* The counter below is used to determine if the TestsaveresultFree routine
|
||||
* was called for a result.
|
||||
*/
|
||||
|
||||
static int freeCount;
|
||||
|
||||
/*
|
||||
* Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
|
||||
*/
|
||||
@@ -294,12 +287,6 @@ static int TestlinkCmd(ClientData dummy,
|
||||
static int TestlocaleCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int TestMathFunc(ClientData clientData,
|
||||
Tcl_Interp *interp, Tcl_Value *args,
|
||||
Tcl_Value *resultPtr);
|
||||
static int TestMathFunc2(ClientData clientData,
|
||||
Tcl_Interp *interp, Tcl_Value *args,
|
||||
Tcl_Value *resultPtr);
|
||||
static int TestmainthreadCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int argc, const char **argv);
|
||||
static int TestsetmainloopCmd(ClientData dummy,
|
||||
@@ -523,8 +510,6 @@ int
|
||||
Tcltest_Init(
|
||||
Tcl_Interp *interp) /* Interpreter for application. */
|
||||
{
|
||||
Tcl_ValueType t3ArgTypes[2];
|
||||
|
||||
Tcl_Obj *listPtr;
|
||||
Tcl_Obj **objv;
|
||||
int objc, index;
|
||||
@@ -533,10 +518,10 @@ Tcltest_Init(
|
||||
"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
|
||||
};
|
||||
|
||||
if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
|
||||
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) {
|
||||
if (Tcl_TomMath_InitStubs(interp, TCL_VERSION) == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_OOInitStubs(interp) == NULL) {
|
||||
@@ -665,8 +650,7 @@ Tcltest_Init(
|
||||
Tcl_CreateCommand(interp, "testtranslatefilename",
|
||||
TesttranslatefilenameCmd, NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
|
||||
Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
|
||||
Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
|
||||
|
||||
Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
|
||||
NULL);
|
||||
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
|
||||
@@ -677,10 +661,6 @@ Tcltest_Init(
|
||||
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
|
||||
(ClientData) 0, NULL);
|
||||
#endif
|
||||
t3ArgTypes[0] = TCL_EITHER;
|
||||
t3ArgTypes[1] = TCL_EITHER;
|
||||
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
|
||||
NULL);
|
||||
|
||||
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
|
||||
NULL, NULL);
|
||||
@@ -1846,7 +1826,7 @@ TestdstringCmd(
|
||||
if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_DStringTrunc(&dstring, count);
|
||||
Tcl_DStringSetLength(&dstring, count);
|
||||
} else if (strcmp(argv[1], "start") == 0) {
|
||||
if (argc != 2) {
|
||||
goto wrongNumArgs;
|
||||
@@ -1972,7 +1952,7 @@ EncodingToUtfProc(
|
||||
TclEncoding *encodingPtr;
|
||||
|
||||
encodingPtr = (TclEncoding *) clientData;
|
||||
Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd);
|
||||
Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);
|
||||
|
||||
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
|
||||
if (len > dstLen) {
|
||||
@@ -2004,7 +1984,7 @@ EncodingFromUtfProc(
|
||||
TclEncoding *encodingPtr;
|
||||
|
||||
encodingPtr = (TclEncoding *) clientData;
|
||||
Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd);
|
||||
Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);
|
||||
|
||||
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
|
||||
if (len > dstLen) {
|
||||
@@ -3299,144 +3279,6 @@ TestlocaleCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TestMathFunc --
|
||||
*
|
||||
* This is a user-defined math procedure to test out math procedures
|
||||
* with no arguments.
|
||||
*
|
||||
* Results:
|
||||
* A normal Tcl completion code.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
static int
|
||||
TestMathFunc(
|
||||
ClientData clientData, /* Integer value to return. */
|
||||
Tcl_Interp *interp, /* Not used. */
|
||||
Tcl_Value *args, /* Not used. */
|
||||
Tcl_Value *resultPtr) /* Where to store result. */
|
||||
{
|
||||
resultPtr->type = TCL_INT;
|
||||
resultPtr->intValue = PTR2INT(clientData);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TestMathFunc2 --
|
||||
*
|
||||
* This is a user-defined math procedure to test out math procedures
|
||||
* that do have arguments, in this case 2.
|
||||
*
|
||||
* Results:
|
||||
* A normal Tcl completion code.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
static int
|
||||
TestMathFunc2(
|
||||
ClientData clientData, /* Integer value to return. */
|
||||
Tcl_Interp *interp, /* Used to report errors. */
|
||||
Tcl_Value *args, /* Points to an array of two Tcl_Value structs
|
||||
* for the two arguments. */
|
||||
Tcl_Value *resultPtr) /* Where to store the result. */
|
||||
{
|
||||
int result = TCL_OK;
|
||||
|
||||
/*
|
||||
* Return the maximum of the two arguments with the correct type.
|
||||
*/
|
||||
|
||||
if (args[0].type == TCL_INT) {
|
||||
int i0 = args[0].intValue;
|
||||
|
||||
if (args[1].type == TCL_INT) {
|
||||
int i1 = args[1].intValue;
|
||||
|
||||
resultPtr->type = TCL_INT;
|
||||
resultPtr->intValue = ((i0 > i1)? i0 : i1);
|
||||
} else if (args[1].type == TCL_DOUBLE) {
|
||||
double d0 = i0;
|
||||
double d1 = args[1].doubleValue;
|
||||
|
||||
resultPtr->type = TCL_DOUBLE;
|
||||
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
|
||||
} else if (args[1].type == TCL_WIDE_INT) {
|
||||
Tcl_WideInt w0 = Tcl_LongAsWide(i0);
|
||||
Tcl_WideInt w1 = args[1].wideValue;
|
||||
|
||||
resultPtr->type = TCL_WIDE_INT;
|
||||
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
|
||||
} else {
|
||||
Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else if (args[0].type == TCL_DOUBLE) {
|
||||
double d0 = args[0].doubleValue;
|
||||
|
||||
if (args[1].type == TCL_INT) {
|
||||
double d1 = args[1].intValue;
|
||||
|
||||
resultPtr->type = TCL_DOUBLE;
|
||||
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
|
||||
} else if (args[1].type == TCL_DOUBLE) {
|
||||
double d1 = args[1].doubleValue;
|
||||
|
||||
resultPtr->type = TCL_DOUBLE;
|
||||
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
|
||||
} else if (args[1].type == TCL_WIDE_INT) {
|
||||
double d1 = Tcl_WideAsDouble(args[1].wideValue);
|
||||
|
||||
resultPtr->type = TCL_DOUBLE;
|
||||
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
|
||||
} else {
|
||||
Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else if (args[0].type == TCL_WIDE_INT) {
|
||||
Tcl_WideInt w0 = args[0].wideValue;
|
||||
|
||||
if (args[1].type == TCL_INT) {
|
||||
Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);
|
||||
|
||||
resultPtr->type = TCL_WIDE_INT;
|
||||
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
|
||||
} else if (args[1].type == TCL_DOUBLE) {
|
||||
double d0 = Tcl_WideAsDouble(w0);
|
||||
double d1 = args[1].doubleValue;
|
||||
|
||||
resultPtr->type = TCL_DOUBLE;
|
||||
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
|
||||
} else if (args[1].type == TCL_WIDE_INT) {
|
||||
Tcl_WideInt w1 = args[1].wideValue;
|
||||
|
||||
resultPtr->type = TCL_WIDE_INT;
|
||||
resultPtr->wideValue = ((w0 > w1)? w0 : w1);
|
||||
} else {
|
||||
Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -4474,7 +4316,7 @@ TestfeventCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (interp2 != NULL) {
|
||||
code = Tcl_GlobalEval(interp2, argv[2]);
|
||||
code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL);
|
||||
Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
|
||||
return code;
|
||||
} else {
|
||||
@@ -5028,7 +4870,6 @@ TestsaveresultCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||||
{
|
||||
Interp* iPtr = (Interp*) interp;
|
||||
int discard, result, index;
|
||||
Tcl_SavedResult state;
|
||||
Tcl_Obj *objPtr;
|
||||
@@ -5079,7 +4920,6 @@ TestsaveresultCmd(
|
||||
break;
|
||||
}
|
||||
|
||||
freeCount = 0;
|
||||
Tcl_SaveResult(interp, &state);
|
||||
|
||||
if (((enum options) index) == RESULT_OBJECT) {
|
||||
@@ -5096,14 +4936,10 @@ TestsaveresultCmd(
|
||||
}
|
||||
|
||||
switch ((enum options) index) {
|
||||
case RESULT_DYNAMIC: {
|
||||
int present = iPtr->freeProc == TestsaveresultFree;
|
||||
int called = freeCount;
|
||||
|
||||
Tcl_AppendElement(interp, called ? "called" : "notCalled");
|
||||
Tcl_AppendElement(interp, present ? "present" : "missing");
|
||||
case RESULT_DYNAMIC:
|
||||
Tcl_AppendElement(interp, discard ? "called" : "notCalled");
|
||||
Tcl_AppendElement(interp, !discard ? "present" : "missing");
|
||||
break;
|
||||
}
|
||||
case RESULT_OBJECT:
|
||||
Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
|
||||
? "same" : "different");
|
||||
@@ -5134,7 +4970,7 @@ static void
|
||||
TestsaveresultFree(
|
||||
char *blockPtr)
|
||||
{
|
||||
freeCount++;
|
||||
/* empty... */
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -835,7 +835,7 @@ ThreadSend(
|
||||
|
||||
if (threadId == Tcl_GetCurrentThread()) {
|
||||
Tcl_MutexUnlock(&threadMutex);
|
||||
return Tcl_GlobalEval(interp, script);
|
||||
return Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1029,7 +1029,7 @@ ThreadEventProc(
|
||||
Tcl_Preserve(interp);
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
|
||||
code = Tcl_GlobalEval(interp, threadEventPtr->script);
|
||||
code = Tcl_EvalEx(interp, threadEventPtr->script, -1, TCL_EVAL_GLOBAL);
|
||||
Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
|
||||
if (code != TCL_OK) {
|
||||
errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
|
||||
|
||||
+5
-198
@@ -1553,40 +1553,6 @@ Tcl_Merge(
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_Backslash --
|
||||
*
|
||||
* Figure out how to handle a backslash sequence.
|
||||
*
|
||||
* Results:
|
||||
* The return value is the character that should be substituted in place
|
||||
* of the backslash sequence that starts at src. If readPtr isn't NULL
|
||||
* then it is filled in with a count of the number of characters in the
|
||||
* backslash sequence.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
char
|
||||
Tcl_Backslash(
|
||||
const char *src, /* Points to the backslash character of a
|
||||
* backslash sequence. */
|
||||
int *readPtr) /* Fill in with number of characters read from
|
||||
* src, unless NULL. */
|
||||
{
|
||||
char buf[TCL_UTF_MAX];
|
||||
Tcl_UniChar ch;
|
||||
|
||||
Tcl_UtfBackslash(src, readPtr, buf);
|
||||
TclUtfToUniChar(buf, &ch);
|
||||
return (char) ch;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2796,7 +2762,6 @@ Tcl_DStringResult(
|
||||
Tcl_DString *dsPtr) /* Dynamic string that is to become the
|
||||
* result of interp. */
|
||||
{
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
|
||||
}
|
||||
|
||||
@@ -2826,77 +2791,12 @@ Tcl_DStringGetResult(
|
||||
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
|
||||
* of interp. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int length;
|
||||
char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
|
||||
|
||||
if (dsPtr->string != dsPtr->staticSpace) {
|
||||
ckfree(dsPtr->string);
|
||||
}
|
||||
|
||||
/*
|
||||
* Do more efficient transfer when we know the result is a Tcl_Obj. When
|
||||
* there's no st`ring result, we only have to deal with two cases:
|
||||
*
|
||||
* 1. When the string rep is the empty string, when we don't copy but
|
||||
* instead use the staticSpace in the DString to hold an empty string.
|
||||
|
||||
* 2. When the string rep is not there or there's a real string rep, when
|
||||
* we use Tcl_GetString to fetch (or generate) the string rep - which
|
||||
* we know to have been allocated with ckalloc() - and use it to
|
||||
* populate the DString space. Then, we free the internal rep. and set
|
||||
* the object's string representation back to the canonical empty
|
||||
* string.
|
||||
*/
|
||||
|
||||
if (!iPtr->result[0] && iPtr->objResultPtr
|
||||
&& !Tcl_IsShared(iPtr->objResultPtr)) {
|
||||
if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
|
||||
dsPtr->string = dsPtr->staticSpace;
|
||||
dsPtr->string[0] = 0;
|
||||
dsPtr->length = 0;
|
||||
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
|
||||
} else {
|
||||
dsPtr->string = Tcl_GetString(iPtr->objResultPtr);
|
||||
dsPtr->length = iPtr->objResultPtr->length;
|
||||
dsPtr->spaceAvl = dsPtr->length + 1;
|
||||
TclFreeIntRep(iPtr->objResultPtr);
|
||||
iPtr->objResultPtr->bytes = tclEmptyStringRep;
|
||||
iPtr->objResultPtr->length = 0;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
* If the string result is empty, move the object result to the string
|
||||
* result, then reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
dsPtr->length = strlen(iPtr->result);
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
dsPtr->string = iPtr->result;
|
||||
dsPtr->spaceAvl = dsPtr->length+1;
|
||||
} else {
|
||||
dsPtr->string = ckalloc(dsPtr->length+1);
|
||||
memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
dsPtr->spaceAvl = dsPtr->length+1;
|
||||
iPtr->freeProc = NULL;
|
||||
} else {
|
||||
if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
|
||||
dsPtr->string = dsPtr->staticSpace;
|
||||
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
|
||||
} else {
|
||||
dsPtr->string = ckalloc(dsPtr->length+1);
|
||||
dsPtr->spaceAvl = dsPtr->length + 1;
|
||||
}
|
||||
memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
|
||||
}
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
Tcl_DStringFree(dsPtr);
|
||||
Tcl_DStringAppend(dsPtr, bytes, length);
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3546,7 +3446,6 @@ TclGetIntForIndex(
|
||||
if (!strncmp(bytes, "end-", 4)) {
|
||||
bytes += 4;
|
||||
}
|
||||
TclCheckBadOctal(interp, bytes);
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
|
||||
}
|
||||
|
||||
@@ -3688,73 +3587,6 @@ SetEndOffsetFromAny(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCheckBadOctal --
|
||||
*
|
||||
* This function checks for a bad octal value and appends a meaningful
|
||||
* error to the interp's result.
|
||||
*
|
||||
* Results:
|
||||
* 1 if the argument was a bad octal, else 0.
|
||||
*
|
||||
* Side effects:
|
||||
* The interpreter's result is modified.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCheckBadOctal(
|
||||
Tcl_Interp *interp, /* Interpreter to use for error reporting. If
|
||||
* NULL, then no error message is left after
|
||||
* errors. */
|
||||
const char *value) /* String to check. */
|
||||
{
|
||||
register const char *p = value;
|
||||
|
||||
/*
|
||||
* A frequent mistake is invalid octal values due to an unwanted leading
|
||||
* zero. Try to generate a meaningful error message.
|
||||
*/
|
||||
|
||||
while (TclIsSpaceProc(*p)) {
|
||||
p++;
|
||||
}
|
||||
if (*p == '+' || *p == '-') {
|
||||
p++;
|
||||
}
|
||||
if (*p == '0') {
|
||||
if ((p[1] == 'o') || p[1] == 'O') {
|
||||
p += 2;
|
||||
}
|
||||
while (isdigit(UCHAR(*p))) { /* INTL: digit. */
|
||||
p++;
|
||||
}
|
||||
while (TclIsSpaceProc(*p)) {
|
||||
p++;
|
||||
}
|
||||
if (*p == '\0') {
|
||||
/*
|
||||
* Reached end of string.
|
||||
*/
|
||||
|
||||
if (interp != NULL) {
|
||||
/*
|
||||
* Don't reset the result here because we want this result to
|
||||
* be added to an existing error message as extra info.
|
||||
*/
|
||||
|
||||
Tcl_AppendToObj(Tcl_GetObjResult(interp),
|
||||
" (looks like invalid octal number)", -1);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -4105,31 +3937,6 @@ Tcl_GetNameOfExecutable(void)
|
||||
return bytes;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpGetTime --
|
||||
*
|
||||
* Deprecated synonym for Tcl_GetTime. This function is provided for the
|
||||
* benefit of extensions written before Tcl_GetTime was exported from the
|
||||
* library.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Stores current time in the buffer designated by "timePtr"
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
TclpGetTime(
|
||||
Tcl_Time *timePtr)
|
||||
{
|
||||
Tcl_GetTime(timePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
@@ -802,9 +802,6 @@ TclObjLookupVarEx(
|
||||
* - Bug #696893 - variable is either proc-local or in the current
|
||||
* namespace; never follow the second (global) resolution path
|
||||
* - Bug #631741 - do not use special namespace or interp resolvers
|
||||
*
|
||||
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
|
||||
* (Bug #835020)
|
||||
*/
|
||||
|
||||
#define AVOID_RESOLVERS 0x40000
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution of
|
||||
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require Tcl 8.6
|
||||
package require Tcl 8.6-
|
||||
# Keep this in sync with pkgIndex.tcl and with the install directories in
|
||||
# Makefiles
|
||||
package provide http 2.8.5
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
|
||||
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
|
||||
package ifneeded http 2.8.5 [list tclPkgSetup $dir http 2.8.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
|
||||
+1
-1
@@ -15,7 +15,7 @@
|
||||
if {[info commands package] == ""} {
|
||||
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
|
||||
}
|
||||
package require -exact Tcl 8.6b3
|
||||
package require -exact Tcl 9.0a0
|
||||
|
||||
# Compute the auto path to use in this interpreter.
|
||||
# The values on the path come from several locations:
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require Tcl 8.5
|
||||
package require Tcl 8.5-
|
||||
# When the version number changes, be sure to update the pkgIndex.tcl file,
|
||||
# and the installation directory in the Makefiles.
|
||||
package provide msgcat 1.5.0
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
|
||||
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
|
||||
package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]]
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
# on it. If your code does rely on this package you
|
||||
# may directly incorporate this code into your application.
|
||||
|
||||
package require Tcl 8.2
|
||||
package require Tcl 8.2-
|
||||
# When this version number changes, update the pkgIndex.tcl file
|
||||
# and the install directory in the Makefiles.
|
||||
package provide opt 0.4.6
|
||||
|
||||
@@ -8,5 +8,5 @@
|
||||
# script is sourced, the variable $dir must contain the
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
|
||||
if {![package vsatisfies [package provide Tcl] 8.2-]} {return}
|
||||
package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]]
|
||||
|
||||
@@ -8,5 +8,5 @@
|
||||
# script is sourced, the variable $dir must contain the
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
|
||||
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
|
||||
package ifneeded tcltest 2.3.4 [list source [file join $dir tcltest.tcl]]
|
||||
|
||||
@@ -16,7 +16,7 @@
|
||||
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
|
||||
# All rights reserved.
|
||||
|
||||
package require Tcl 8.5 ;# -verbose line uses [info frame]
|
||||
package require Tcl 8.5- ;# -verbose line uses [info frame]
|
||||
namespace eval tcltest {
|
||||
|
||||
# When the version number changes, be sure to update the pkgIndex.tcl file,
|
||||
|
||||
@@ -34,4 +34,4 @@ TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
|
||||
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
|
||||
TCL_PACKAGE_PATH = "$(LIBDIR)"
|
||||
TCL_DEFS = HAVE_TCL_CONFIG_H
|
||||
VERSION = 8.6
|
||||
VERSION = 9.0
|
||||
|
||||
+1
-1
@@ -11,7 +11,7 @@
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package prefer latest
|
||||
package require Tcl 8.5
|
||||
package require Tcl 8.5-
|
||||
package require tcltest 2.2
|
||||
namespace import tcltest::*
|
||||
configure {*}$argv -testdir [file dir [info script]]
|
||||
|
||||
+1
-1
@@ -782,7 +782,7 @@ test assemble-7.43 {uplus} {
|
||||
}
|
||||
}
|
||||
-returnCodes error
|
||||
-result {can't use non-numeric floating-point value as operand of "+"}
|
||||
-result {can't use non-numeric floating-point value "NaN" as operand of "+"}
|
||||
}
|
||||
test assemble-7.43.1 {tryCvtToNumeric} {
|
||||
-body {
|
||||
|
||||
@@ -1,89 +0,0 @@
|
||||
# Commands covered: case
|
||||
#
|
||||
# This file contains a collection of tests for one or more of the Tcl
|
||||
# built-in commands. Sourcing this file into Tcl runs the tests and
|
||||
# generates output for errors. No output means no errors were found.
|
||||
#
|
||||
# Copyright (c) 1991-1993 The Regents of the University of California.
|
||||
# Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
if {[lsearch [namespace children] ::tcltest] == -1} {
|
||||
package require tcltest
|
||||
namespace import -force ::tcltest::*
|
||||
}
|
||||
|
||||
test case-1.1 {simple pattern} {
|
||||
case a in a {format 1} b {format 2} c {format 3} default {format 4}
|
||||
} 1
|
||||
test case-1.2 {simple pattern} {
|
||||
case b a {format 1} b {format 2} c {format 3} default {format 4}
|
||||
} 2
|
||||
test case-1.3 {simple pattern} {
|
||||
case x in a {format 1} b {format 2} c {format 3} default {format 4}
|
||||
} 4
|
||||
test case-1.4 {simple pattern} {
|
||||
case x a {format 1} b {format 2} c {format 3}
|
||||
} {}
|
||||
test case-1.5 {simple pattern matches many times} {
|
||||
case b a {format 1} b {format 2} b {format 3} b {format 4}
|
||||
} 2
|
||||
test case-1.6 {fancier pattern} {
|
||||
case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
|
||||
} 3
|
||||
test case-1.7 {list of patterns} {
|
||||
case abc in {a b c} {format 1} {def abc ghi} {format 2}
|
||||
} 2
|
||||
|
||||
test case-2.1 {error in executed command} {
|
||||
list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
|
||||
$msg $::errorInfo
|
||||
} {1 {Just a test} {Just a test
|
||||
while executing
|
||||
"error "Just a test""
|
||||
("a" arm line 1)
|
||||
invoked from within
|
||||
"case a in a {error "Just a test"} default {format 1}"}}
|
||||
test case-2.2 {error: not enough args} {
|
||||
list [catch {case} msg] $msg
|
||||
} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}}
|
||||
test case-2.3 {error: pattern with no body} {
|
||||
list [catch {case a b} msg] $msg
|
||||
} {1 {extra case pattern with no body}}
|
||||
test case-2.4 {error: pattern with no body} {
|
||||
list [catch {case a in b {format 1} c} msg] $msg
|
||||
} {1 {extra case pattern with no body}}
|
||||
test case-2.5 {error in default command} {
|
||||
list [catch {case foo in a {error case1} default {error case2} \
|
||||
b {error case 3}} msg] $msg $::errorInfo
|
||||
} {1 case2 {case2
|
||||
while executing
|
||||
"error case2"
|
||||
("default" arm line 1)
|
||||
invoked from within
|
||||
"case foo in a {error case1} default {error case2} b {error case 3}"}}
|
||||
|
||||
test case-3.1 {single-argument form for pattern/command pairs} {
|
||||
case b in {
|
||||
a {format 1}
|
||||
b {format 2}
|
||||
default {format 6}
|
||||
}
|
||||
} {2}
|
||||
test case-3.2 {single-argument form for pattern/command pairs} {
|
||||
case b {
|
||||
a {format 1}
|
||||
b {format 2}
|
||||
default {format 6}
|
||||
}
|
||||
} {2}
|
||||
test case-3.3 {single-argument form for pattern/command pairs} {
|
||||
list [catch {case z in {a 2 b}} msg] $msg
|
||||
} {1 {extra case pattern with no body}}
|
||||
|
||||
# cleanup
|
||||
::tcltest::cleanupTests
|
||||
return
|
||||
@@ -59,8 +59,6 @@ test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
|
||||
list [catch {break} msg] $msg
|
||||
} {3 {}}
|
||||
|
||||
# Tcl_CaseObjCmd is tested in case.test
|
||||
|
||||
test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
|
||||
catch
|
||||
} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
|
||||
|
||||
+12
-34
@@ -18,13 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
|
||||
}
|
||||
|
||||
::tcltest::loadTestedCommands
|
||||
catch [list package require -exact Tcltest [info patchlevel]]
|
||||
|
||||
if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
|
||||
testConstraint testmathfunctions 0
|
||||
} else {
|
||||
testConstraint testmathfunctions 1
|
||||
}
|
||||
|
||||
# Big test for correct ordering of data in [expr]
|
||||
|
||||
@@ -285,10 +278,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
|
||||
list [catch {expr {24.0^3}} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "^"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of "^"}}
|
||||
test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
|
||||
list [catch {expr {"a"^"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "^"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "^"}}
|
||||
|
||||
test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
|
||||
test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
|
||||
@@ -309,10 +302,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
|
||||
list [catch {expr {24.0&3}} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "&"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of "&"}}
|
||||
test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
|
||||
list [catch {expr {"a"&"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "&"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "&"}}
|
||||
|
||||
test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
|
||||
test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
|
||||
@@ -377,10 +370,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
|
||||
list [catch {expr {24.0>>43}} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of ">>"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
|
||||
test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
|
||||
list [catch {expr {"a"<<"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "<<"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "<<"}}
|
||||
|
||||
test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
|
||||
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
|
||||
@@ -399,10 +392,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
|
||||
list [catch {expr {24.0+"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "+"}}
|
||||
test compExpr-old-11.11 {CompileAddExpr: runtime error} {
|
||||
list [catch {expr {"a"-"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "-"}}
|
||||
test compExpr-old-11.12 {CompileAddExpr: runtime error} {
|
||||
list [catch {expr {3/0}} msg] $msg
|
||||
} {1 {divide by zero}}
|
||||
@@ -430,10 +423,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
|
||||
list [catch {expr {24.0*"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "*"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "*"}}
|
||||
test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
|
||||
list [catch {expr {"a"/"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "/"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "/"}}
|
||||
|
||||
test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
|
||||
test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
|
||||
@@ -451,10 +444,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
|
||||
list [catch {expr {~"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "~"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "~"}}
|
||||
test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
|
||||
list [catch {expr ~4.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "~"}}
|
||||
} {1 {can't use floating-point value "4.0" as operand of "~"}}
|
||||
test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
|
||||
test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
|
||||
set a 27
|
||||
@@ -602,21 +595,6 @@ test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
|
||||
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
|
||||
expr sin(1
|
||||
} -returnCodes error -match glob -result *
|
||||
test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr 2*T1()
|
||||
} 246
|
||||
test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr T2()*3
|
||||
} 1035
|
||||
test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr T3(21, 37)
|
||||
} 37
|
||||
test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr T3(21.2, 37)
|
||||
} 37.0
|
||||
test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr T3(-21.2, -17.5)
|
||||
} -17.5
|
||||
|
||||
test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
|
||||
catch {unset a}
|
||||
|
||||
@@ -14,13 +14,6 @@ if {"::tcltest" ni [namespace children]} {
|
||||
}
|
||||
|
||||
::tcltest::loadTestedCommands
|
||||
catch [list package require -exact Tcltest [info patchlevel]]
|
||||
|
||||
if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
|
||||
testConstraint testmathfunctions 0
|
||||
} else {
|
||||
testConstraint testmathfunctions 1
|
||||
}
|
||||
|
||||
# Constrain memory leak tests
|
||||
testConstraint memory [llength [info commands memory]]
|
||||
@@ -319,12 +312,6 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
|
||||
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
|
||||
expr {do_it()}
|
||||
} -returnCodes error -match glob -result {* "*do_it"}
|
||||
test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr 3*T1()-1
|
||||
} 368
|
||||
test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions {
|
||||
expr T2()*3
|
||||
} 1035
|
||||
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
|
||||
expr {atan2(1.0)}
|
||||
} -returnCodes error -match glob -result {too few arguments for math function*}
|
||||
|
||||
+1
-1
@@ -282,7 +282,7 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
|
||||
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
|
||||
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
|
||||
apply {{} { set r [list foobar] ; string index a 0o9 }}
|
||||
} -returnCodes error -match glob -result {*invalid octal number*}
|
||||
} -returnCodes error -match glob -result {*}
|
||||
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
|
||||
apply {{} { set r [list foobar] ; array set var {one two many} }}
|
||||
} -returnCodes error -result {list must have an even number of elements}
|
||||
|
||||
+11
-11
@@ -174,7 +174,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj}
|
||||
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 0 foo]
|
||||
list [catch {expr {$x + 1}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "+"}}
|
||||
test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
|
||||
set x [testintobj set 0 1]
|
||||
expr {1 + $x}
|
||||
@@ -199,7 +199,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj}
|
||||
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 0 foo]
|
||||
list [catch {expr {1 + $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "+"}}
|
||||
|
||||
# INST_SUB is partially tested:
|
||||
test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
|
||||
@@ -226,7 +226,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj}
|
||||
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 0 foo]
|
||||
list [catch {expr {$x - 1}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "-"}}
|
||||
test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
|
||||
set x [testintobj set 0 1]
|
||||
expr {1 - $x}
|
||||
@@ -251,7 +251,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj}
|
||||
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 0 foo]
|
||||
list [catch {expr {1 - $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "-"}}
|
||||
|
||||
# INST_MULT is partially tested:
|
||||
test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
|
||||
@@ -278,7 +278,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj
|
||||
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {$x * 1}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "*"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "*"}}
|
||||
test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
|
||||
set x [testintobj set 1 1]
|
||||
expr {1 * $x}
|
||||
@@ -303,7 +303,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj
|
||||
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {1 * $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "*"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "*"}}
|
||||
|
||||
# INST_DIV is partially tested:
|
||||
test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
|
||||
@@ -330,7 +330,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj}
|
||||
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {$x / 1}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "/"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "/"}}
|
||||
test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
|
||||
set x [testintobj set 1 1]
|
||||
expr {2 / $x}
|
||||
@@ -355,7 +355,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj}
|
||||
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {1 / $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "/"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "/"}}
|
||||
|
||||
# INST_UPLUS is partially tested:
|
||||
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
|
||||
@@ -382,7 +382,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj
|
||||
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {+ $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "+"}}
|
||||
|
||||
# INST_UMINUS is partially tested:
|
||||
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
|
||||
@@ -409,7 +409,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob
|
||||
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {- $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "-"}}
|
||||
|
||||
# INST_LNOT is partially tested:
|
||||
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
|
||||
@@ -457,7 +457,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj}
|
||||
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
|
||||
set x [teststringobj set 1 foo]
|
||||
list [catch {expr {! $x}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "foo" as operand of "!"}}
|
||||
|
||||
# INST_BITNOT not tested
|
||||
# INST_CALL_BUILTIN_FUNC1 not tested
|
||||
|
||||
+32
-48
@@ -26,12 +26,6 @@ testConstraint testexprdouble [llength [info commands testexprdouble]]
|
||||
testConstraint testexprstring [llength [info commands testexprstring]]
|
||||
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
|
||||
|
||||
if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
|
||||
testConstraint testmathfunctions 0
|
||||
} else {
|
||||
testConstraint testmathfunctions 1
|
||||
}
|
||||
|
||||
# Big test for correct ordering of data in [expr]
|
||||
|
||||
proc testIEEE {} {
|
||||
@@ -199,34 +193,34 @@ test expr-old-2.38 {floating-point operators} {
|
||||
|
||||
test expr-old-3.1 {illegal floating-point operations} {
|
||||
list [catch {expr ~4.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "~"}}
|
||||
} {1 {can't use floating-point value "4.0" as operand of "~"}}
|
||||
test expr-old-3.2 {illegal floating-point operations} {
|
||||
list [catch {expr 27%4.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "%"}}
|
||||
} {1 {can't use floating-point value "4.0" as operand of "%"}}
|
||||
test expr-old-3.3 {illegal floating-point operations} {
|
||||
list [catch {expr 27.0%4} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "%"}}
|
||||
} {1 {can't use floating-point value "27.0" as operand of "%"}}
|
||||
test expr-old-3.4 {illegal floating-point operations} {
|
||||
list [catch {expr 1.0<<3} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "<<"}}
|
||||
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
|
||||
test expr-old-3.5 {illegal floating-point operations} {
|
||||
list [catch {expr 3<<1.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "<<"}}
|
||||
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
|
||||
test expr-old-3.6 {illegal floating-point operations} {
|
||||
list [catch {expr 24.0>>3} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of ">>"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
|
||||
test expr-old-3.7 {illegal floating-point operations} {
|
||||
list [catch {expr 24>>3.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of ">>"}}
|
||||
} {1 {can't use floating-point value "3.0" as operand of ">>"}}
|
||||
test expr-old-3.8 {illegal floating-point operations} {
|
||||
list [catch {expr 24&3.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "&"}}
|
||||
} {1 {can't use floating-point value "3.0" as operand of "&"}}
|
||||
test expr-old-3.9 {illegal floating-point operations} {
|
||||
list [catch {expr 24.0|3} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "|"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of "|"}}
|
||||
test expr-old-3.10 {illegal floating-point operations} {
|
||||
list [catch {expr 24.0^3} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "^"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of "^"}}
|
||||
|
||||
# Check the string operators individually.
|
||||
|
||||
@@ -267,46 +261,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar
|
||||
|
||||
test expr-old-5.1 {illegal string operations} {
|
||||
list [catch {expr {-"a"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "-"}}
|
||||
test expr-old-5.2 {illegal string operations} {
|
||||
list [catch {expr {+"a"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "+"}}
|
||||
test expr-old-5.3 {illegal string operations} {
|
||||
list [catch {expr {~"a"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "~"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "~"}}
|
||||
test expr-old-5.4 {illegal string operations} {
|
||||
list [catch {expr {!"a"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "!"}}
|
||||
test expr-old-5.5 {illegal string operations} {
|
||||
list [catch {expr {"a"*"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "*"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "*"}}
|
||||
test expr-old-5.6 {illegal string operations} {
|
||||
list [catch {expr {"a"/"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "/"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "/"}}
|
||||
test expr-old-5.7 {illegal string operations} {
|
||||
list [catch {expr {"a"%"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "%"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "%"}}
|
||||
test expr-old-5.8 {illegal string operations} {
|
||||
list [catch {expr {"a"+"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "+"}}
|
||||
test expr-old-5.9 {illegal string operations} {
|
||||
list [catch {expr {"a"-"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "-"}}
|
||||
test expr-old-5.10 {illegal string operations} {
|
||||
list [catch {expr {"a"<<"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "<<"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "<<"}}
|
||||
test expr-old-5.11 {illegal string operations} {
|
||||
list [catch {expr {"a">>"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of ">>"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of ">>"}}
|
||||
test expr-old-5.12 {illegal string operations} {
|
||||
list [catch {expr {"a"&"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "&"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "&"}}
|
||||
test expr-old-5.13 {illegal string operations} {
|
||||
list [catch {expr {"a"^"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "^"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "^"}}
|
||||
test expr-old-5.14 {illegal string operations} {
|
||||
list [catch {expr {"a"|"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "|"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "|"}}
|
||||
test expr-old-5.15 {illegal string operations} {
|
||||
list [catch {expr {"a"&&"b"}} msg] $msg
|
||||
} {1 {expected boolean value but got "a"}}
|
||||
@@ -495,7 +489,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0
|
||||
|
||||
test expr-old-26.1 {error conditions} {
|
||||
list [catch {expr 2+"a"} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "+"}}
|
||||
test expr-old-26.2 {error conditions} -body {
|
||||
expr 2+4*
|
||||
} -returnCodes error -match glob -result *
|
||||
@@ -509,10 +503,10 @@ test expr-old-26.4 {error conditions} {
|
||||
set a xx
|
||||
test expr-old-26.5 {error conditions} {
|
||||
list [catch {expr {2+$a}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "+"}}
|
||||
test expr-old-26.6 {error conditions} {
|
||||
list [catch {expr {2+[set a]}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "+"}}
|
||||
test expr-old-26.7 {error conditions} -body {
|
||||
expr {2+(4}
|
||||
} -returnCodes error -match glob -result *
|
||||
@@ -536,7 +530,7 @@ test expr-old-26.12 {error conditions} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-old-26.13 {error conditions} {
|
||||
list [catch {expr {"a"/"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "/"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "/"}}
|
||||
test expr-old-26.14 {error conditions} -body {
|
||||
expr 2:3
|
||||
} -returnCodes error -match glob -result *
|
||||
@@ -849,12 +843,6 @@ test expr-old-32.41 {math functions in expressions} {
|
||||
test expr-old-32.42 {math functions in expressions} {
|
||||
list [catch {expr hypot(5*.8,3)} msg] $msg
|
||||
} {0 5.0}
|
||||
test expr-old-32.43 {math functions in expressions} testmathfunctions {
|
||||
expr 2*T1()
|
||||
} 246
|
||||
test expr-old-32.44 {math functions in expressions} testmathfunctions {
|
||||
expr T2()*3
|
||||
} 1035
|
||||
test expr-old-32.45 {math functions in expressions} {
|
||||
expr (0 <= rand()) && (rand() < 1)
|
||||
} {1}
|
||||
@@ -954,10 +942,6 @@ test expr-old-34.15 {errors in math functions} {
|
||||
test expr-old-34.16 {errors in math functions} {
|
||||
expr round(-1.0e30)
|
||||
} -1000000000000000019884624838656
|
||||
test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
|
||||
-body {
|
||||
list [catch {expr T1(4)} msg] $msg
|
||||
} -match glob -result {1 {too many arguments for math function*}}
|
||||
|
||||
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
|
||||
expr 0o289
|
||||
@@ -965,7 +949,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
|
||||
test expr-old-36.2 {ExprLooksLikeInt procedure} {
|
||||
set x 0o289
|
||||
list [catch {expr {$x+1}} msg] $msg
|
||||
} {1 {can't use invalid octal number as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
|
||||
test expr-old-36.3 {ExprLooksLikeInt procedure} {
|
||||
list [catch {expr 0289.1} msg] $msg
|
||||
} {0 289.1}
|
||||
@@ -1005,11 +989,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} {
|
||||
test expr-old-36.12 {ExprLooksLikeInt procedure} {
|
||||
set x "10;"
|
||||
list [catch {expr {$x+1}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "10;" as operand of "+"}}
|
||||
test expr-old-36.13 {ExprLooksLikeInt procedure} {
|
||||
set x " +"
|
||||
list [catch {expr {$x+1}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string " +" as operand of "+"}}
|
||||
test expr-old-36.14 {ExprLooksLikeInt procedure} {
|
||||
set x "123456789012345678901234567890 "
|
||||
expr {$x+1}
|
||||
@@ -1017,7 +1001,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} {
|
||||
test expr-old-36.15 {ExprLooksLikeInt procedure} {
|
||||
set x "0o99 "
|
||||
list [catch {expr {$x+1}} msg] $msg
|
||||
} {1 {can't use invalid octal number as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "0o99 " as operand of "+"}}
|
||||
test expr-old-36.16 {ExprLooksLikeInt procedure} {
|
||||
set x " 0xffffffffffffffffffffffffffffffffffffff "
|
||||
expr {$x+1}
|
||||
|
||||
+23
-63
@@ -16,11 +16,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
|
||||
}
|
||||
|
||||
::tcltest::loadTestedCommands
|
||||
catch [list package require -exact Tcltest [info patchlevel]]
|
||||
|
||||
testConstraint testmathfunctions [expr {
|
||||
([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
|
||||
}]
|
||||
|
||||
# Determine if "long int" type is a 32 bit number and if the wide
|
||||
# type is a 64 bit number on this machine.
|
||||
@@ -257,7 +252,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} {
|
||||
} 1
|
||||
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
|
||||
list [catch {expr {!"a"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "!"}}
|
||||
test expr-4.11 {CompileLorExpr: error compiling land arms} {
|
||||
list [catch {expr {"a"||0}} msg] $msg
|
||||
} {1 {expected boolean value but got "a"}}
|
||||
@@ -304,10 +299,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
|
||||
list [catch {expr {24.0^3}} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "^"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of "^"}}
|
||||
test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
|
||||
list [catch {expr {"a"^"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "^"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "^"}}
|
||||
|
||||
test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
|
||||
test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
|
||||
@@ -328,10 +323,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
|
||||
list [catch {expr {24.0&3}} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "&"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of "&"}}
|
||||
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
|
||||
list [catch {expr {"a"&"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "&"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "&"}}
|
||||
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
|
||||
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
|
||||
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
|
||||
@@ -456,10 +451,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-10.10 {CompileShiftExpr: runtime error} {
|
||||
list [catch {expr {24.0>>43}} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of ">>"}}
|
||||
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
|
||||
test expr-10.11 {CompileShiftExpr: runtime error} {
|
||||
list [catch {expr {"a"<<"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "<<"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "<<"}}
|
||||
|
||||
test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
|
||||
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
|
||||
@@ -478,10 +473,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-11.10 {CompileAddExpr: runtime error} {
|
||||
list [catch {expr {24.0+"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "+"}}
|
||||
test expr-11.11 {CompileAddExpr: runtime error} {
|
||||
list [catch {expr {"a"-"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "-"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "-"}}
|
||||
test expr-11.12 {CompileAddExpr: runtime error} {
|
||||
list [catch {expr {3/0}} msg] $msg
|
||||
} {1 {divide by zero}}
|
||||
@@ -509,10 +504,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-12.10 {CompileMultiplyExpr: runtime error} {
|
||||
list [catch {expr {24.0*"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "*"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "*"}}
|
||||
test expr-12.11 {CompileMultiplyExpr: runtime error} {
|
||||
list [catch {expr {"a"/"b"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "/"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "/"}}
|
||||
|
||||
test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
|
||||
test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
|
||||
@@ -529,10 +524,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-13.10 {CompileUnaryExpr: runtime error} {
|
||||
list [catch {expr {~"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "~"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "~"}}
|
||||
test expr-13.11 {CompileUnaryExpr: runtime error} {
|
||||
list [catch {expr ~4.0} msg] $msg
|
||||
} {1 {can't use floating-point value as operand of "~"}}
|
||||
} {1 {can't use floating-point value "4.0" as operand of "~"}}
|
||||
test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
|
||||
test expr-13.13 {CompileUnaryExpr: just primary expr} {
|
||||
set a 27
|
||||
@@ -685,41 +680,6 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
|
||||
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
|
||||
expr sin(1
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
|
||||
expr 2*T1()
|
||||
} 246
|
||||
test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
|
||||
expr T2()*3
|
||||
} 1035
|
||||
test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
|
||||
expr T3(21, 37)
|
||||
} 37
|
||||
test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
|
||||
expr T3(21.2, 37)
|
||||
} 37.0
|
||||
test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
|
||||
expr T3(-21.2, -17.5)
|
||||
} -17.5
|
||||
test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
|
||||
expr T3(21, wide(37))
|
||||
} 37
|
||||
test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
|
||||
expr T3(wide(21), 37)
|
||||
} 37
|
||||
test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
|
||||
expr T3(wide(21), wide(37))
|
||||
} 37
|
||||
test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
|
||||
expr T3(21.0, wide(37))
|
||||
} 37.0
|
||||
test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
|
||||
expr T3(wide(21), 37.0)
|
||||
} 37.0
|
||||
test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
|
||||
testmathfunctions
|
||||
} -body {
|
||||
expr T3(0,"a")
|
||||
} -returnCodes error -result {argument to math function didn't have numeric value}
|
||||
|
||||
|
||||
test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
|
||||
@@ -844,15 +804,15 @@ test expr-21.13 {non-numeric boolean literals} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-21.14 {non-numeric boolean literals} {
|
||||
list [catch {expr !"truef"} err] $err
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "truef" as operand of "!"}}
|
||||
test expr-21.15 {non-numeric boolean variables} {
|
||||
set v truef
|
||||
list [catch {expr {!$v}} err] $err
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "truef" as operand of "!"}}
|
||||
test expr-21.16 {non-numeric boolean variables} {
|
||||
set v "true "
|
||||
list [catch {expr {!$v}} err] $err
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "true " as operand of "!"}}
|
||||
test expr-21.17 {non-numeric boolean variables} {
|
||||
set v "tru"
|
||||
list [catch {expr {!$v}} err] $err
|
||||
@@ -872,23 +832,23 @@ test expr-21.20 {non-numeric boolean variables} {
|
||||
test expr-21.21 {non-numeric boolean variables} {
|
||||
set v "o"
|
||||
list [catch {expr {!$v}} err] $err
|
||||
} {1 {can't use non-numeric string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "o" as operand of "!"}}
|
||||
test expr-21.22 {non-numeric boolean variables} {
|
||||
set v ""
|
||||
list [catch {expr {!$v}} err] $err
|
||||
} {1 {can't use empty string as operand of "!"}}
|
||||
} {1 {can't use non-numeric string "" as operand of "!"}}
|
||||
|
||||
# Test for non-numeric float handling.
|
||||
test expr-22.1 {non-numeric floats} {
|
||||
list [catch {expr {NaN + 1}} msg] $msg
|
||||
} {1 {can't use non-numeric floating-point value as operand of "+"}}
|
||||
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
|
||||
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
|
||||
list [catch {expr {Inf + 1}} msg] $msg
|
||||
} {1 {can't use infinite floating-point value as operand of "+"}}
|
||||
test expr-22.3 {non-numeric floats} {
|
||||
set nan NaN
|
||||
list [catch {expr {$nan + 1}} msg] $msg
|
||||
} {1 {can't use non-numeric floating-point value as operand of "+"}}
|
||||
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
|
||||
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
|
||||
set inf Inf
|
||||
list [catch {expr {$inf + 1}} msg] $msg
|
||||
@@ -901,7 +861,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
|
||||
} {1 {floating-point value too large to represent}}
|
||||
test expr-22.7 {non-numeric floats} {
|
||||
list [catch {expr {1 / NaN}} msg] $msg
|
||||
} {1 {can't use non-numeric floating-point value as operand of "/"}}
|
||||
} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}}
|
||||
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
|
||||
list [catch {expr {1 / Inf}} msg] $msg
|
||||
} {1 {can't use infinite floating-point value as operand of "/"}}
|
||||
@@ -928,10 +888,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
|
||||
} -returnCodes error -match glob -result *
|
||||
test expr-23.9 {CompileExponentialExpr: runtime error} {
|
||||
list [catch {expr {24.0**"xx"}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "**"}}
|
||||
} {1 {can't use non-numeric string "xx" as operand of "**"}}
|
||||
test expr-23.10 {CompileExponentialExpr: runtime error} {
|
||||
list [catch {expr {"a"**2}} msg] $msg
|
||||
} {1 {can't use non-numeric string as operand of "**"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "**"}}
|
||||
test expr-23.11 {CompileExponentialExpr: runtime error} {
|
||||
list [catch {expr {0**-1}} msg] $msg
|
||||
} {1 {exponentiation of zero by negative power}}
|
||||
|
||||
+1
-1
@@ -8,7 +8,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require Tcl 8.6
|
||||
package require Tcl 8.6-
|
||||
|
||||
proc ::tcl::dict::get? {dict key} {
|
||||
if {[dict exists $dict $key]} {
|
||||
|
||||
+8
-8
@@ -70,11 +70,11 @@ test lindex-3.4 {integer 3} testevalex {
|
||||
test lindex-3.5 {bad octal} -constraints testevalex -body {
|
||||
set x 0o8
|
||||
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-3.6 {bad octal} -constraints testevalex -body {
|
||||
set x -0o9
|
||||
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-3.7 {indexes don't shimmer wide ints} {
|
||||
set x [expr {(wide(1)<<31) - 2}]
|
||||
list $x [lindex {1 2 3} $x] [incr x] [incr x]
|
||||
@@ -105,11 +105,11 @@ test lindex-4.5 {index = end-3} testevalex {
|
||||
test lindex-4.6 {bad octal} -constraints testevalex -body {
|
||||
set x end-0o8
|
||||
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-4.7 {bad octal} -constraints testevalex -body {
|
||||
set x end--0o9
|
||||
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-4.8 {bad integer, not octal} testevalex {
|
||||
set x end-0a2
|
||||
list [catch { testevalex {lindex {a b c} $x} } result] $result
|
||||
@@ -261,11 +261,11 @@ test lindex-11.4 {integer 3} {
|
||||
test lindex-11.5 {bad octal} -body {
|
||||
set x 0o8
|
||||
list [catch { lindex {a b c} $x } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-11.6 {bad octal} -body {
|
||||
set x -0o9
|
||||
list [catch { lindex {a b c} $x } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
|
||||
# Indices relative to end
|
||||
|
||||
@@ -307,11 +307,11 @@ test lindex-12.5 {index = end-3} {
|
||||
test lindex-12.6 {bad octal} -body {
|
||||
set x end-0o8
|
||||
list [catch { lindex {a b c} $x } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-12.7 {bad octal} -body {
|
||||
set x end--0o9
|
||||
list [catch { lindex {a b c} $x } result] $result
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test lindex-12.8 {bad integer, not octal} {
|
||||
set x end-0a2
|
||||
list [catch { lindex {a b c} $x } result] $result
|
||||
|
||||
+1
-1
@@ -16,7 +16,7 @@ namespace eval ::tcl::test::main {
|
||||
# - tests use testing commands introduced in Tcltest 8.4
|
||||
testConstraint Tcltest [expr {
|
||||
[llength [package provide Tcltest]]
|
||||
&& [package vsatisfies [package provide Tcltest] 8.4]}]
|
||||
&& [package vsatisfies [package provide Tcltest] 8.4-]}]
|
||||
|
||||
# Procedure to simulate interactive typing of commands, line by line
|
||||
proc type {chan script} {
|
||||
|
||||
+97
-97
@@ -114,22 +114,22 @@ namespace eval ::testmathop {
|
||||
test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
|
||||
test mathop-1.11 {compiled +: errors} -returnCodes error -body {
|
||||
+ x 0
|
||||
} -result {can't use non-numeric string as operand of "+"}
|
||||
} -result {can't use non-numeric string "x" as operand of "+"}
|
||||
test mathop-1.12 {compiled +: errors} -returnCodes error -body {
|
||||
+ nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "+"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
|
||||
test mathop-1.13 {compiled +: errors} -returnCodes error -body {
|
||||
+ 0 x
|
||||
} -result {can't use non-numeric string as operand of "+"}
|
||||
} -result {can't use non-numeric string "x" as operand of "+"}
|
||||
test mathop-1.14 {compiled +: errors} -returnCodes error -body {
|
||||
+ 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "+"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
|
||||
test mathop-1.15 {compiled +: errors} -returnCodes error -body {
|
||||
+ 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "+"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "+"}
|
||||
test mathop-1.16 {compiled +: errors} -returnCodes error -body {
|
||||
+ 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "+"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "+"}
|
||||
test mathop-1.17 {compiled +: errors} -returnCodes error -body {
|
||||
+ 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -152,22 +152,22 @@ namespace eval ::testmathop {
|
||||
test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
|
||||
test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
|
||||
$op x 0
|
||||
} -result {can't use non-numeric string as operand of "+"}
|
||||
} -result {can't use non-numeric string "x" as operand of "+"}
|
||||
test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
|
||||
$op nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "+"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
|
||||
test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
|
||||
$op 0 x
|
||||
} -result {can't use non-numeric string as operand of "+"}
|
||||
} -result {can't use non-numeric string "x" as operand of "+"}
|
||||
test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
|
||||
$op 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "+"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "+"}
|
||||
test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
|
||||
$op 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "+"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "+"}
|
||||
test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
|
||||
$op 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "+"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "+"}
|
||||
test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
|
||||
$op 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -189,22 +189,22 @@ namespace eval ::testmathop {
|
||||
test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
|
||||
test mathop-2.11 {compiled *: errors} -returnCodes error -body {
|
||||
* x 0
|
||||
} -result {can't use non-numeric string as operand of "*"}
|
||||
} -result {can't use non-numeric string "x" as operand of "*"}
|
||||
test mathop-2.12 {compiled *: errors} -returnCodes error -body {
|
||||
* nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "*"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
|
||||
test mathop-2.13 {compiled *: errors} -returnCodes error -body {
|
||||
* 0 x
|
||||
} -result {can't use non-numeric string as operand of "*"}
|
||||
} -result {can't use non-numeric string "x" as operand of "*"}
|
||||
test mathop-2.14 {compiled *: errors} -returnCodes error -body {
|
||||
* 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "*"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
|
||||
test mathop-2.15 {compiled *: errors} -returnCodes error -body {
|
||||
* 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "*"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "*"}
|
||||
test mathop-2.16 {compiled *: errors} -returnCodes error -body {
|
||||
* 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "*"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "*"}
|
||||
test mathop-2.17 {compiled *: errors} -returnCodes error -body {
|
||||
* 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -227,22 +227,22 @@ namespace eval ::testmathop {
|
||||
test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
|
||||
test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
|
||||
$op x 0
|
||||
} -result {can't use non-numeric string as operand of "*"}
|
||||
} -result {can't use non-numeric string "x" as operand of "*"}
|
||||
test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
|
||||
$op nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "*"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
|
||||
test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
|
||||
$op 0 x
|
||||
} -result {can't use non-numeric string as operand of "*"}
|
||||
} -result {can't use non-numeric string "x" as operand of "*"}
|
||||
test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
|
||||
$op 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "*"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "*"}
|
||||
test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
|
||||
$op 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "*"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "*"}
|
||||
test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
|
||||
$op 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "*"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "*"}
|
||||
test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
|
||||
$op 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -261,7 +261,7 @@ namespace eval ::testmathop {
|
||||
test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
|
||||
test mathop-3.8 {compiled !: errors} -body {
|
||||
! foobar
|
||||
} -returnCodes error -result {can't use non-numeric string as operand of "!"}
|
||||
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
|
||||
test mathop-3.9 {compiled !: errors} -body {
|
||||
! 0 0
|
||||
} -returnCodes error -result "wrong # args: should be \"! boolean\""
|
||||
@@ -278,7 +278,7 @@ namespace eval ::testmathop {
|
||||
test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
|
||||
test mathop-3.18 {interpreted !: errors} -body {
|
||||
$op foobar
|
||||
} -returnCodes error -result {can't use non-numeric string as operand of "!"}
|
||||
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
|
||||
test mathop-3.19 {interpreted !: errors} -body {
|
||||
$op 0 0
|
||||
} -returnCodes error -result "wrong # args: should be \"! boolean\""
|
||||
@@ -287,10 +287,10 @@ namespace eval ::testmathop {
|
||||
} -returnCodes error -result "wrong # args: should be \"! boolean\""
|
||||
test mathop-3.21 {compiled !: error} -returnCodes error -body {
|
||||
! NaN
|
||||
} -result {can't use non-numeric floating-point value as operand of "!"}
|
||||
} -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
|
||||
test mathop-3.22 {interpreted !: error} -returnCodes error -body {
|
||||
$op NaN
|
||||
} -result {can't use non-numeric floating-point value as operand of "!"}
|
||||
} -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
|
||||
|
||||
test mathop-4.1 {compiled ~} {~ 0} -1
|
||||
test mathop-4.2 {compiled ~} {~ 1} -2
|
||||
@@ -301,7 +301,7 @@ namespace eval ::testmathop {
|
||||
test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
|
||||
test mathop-4.8 {compiled ~: errors} -body {
|
||||
~ foobar
|
||||
} -returnCodes error -result {can't use non-numeric string as operand of "~"}
|
||||
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
|
||||
test mathop-4.9 {compiled ~: errors} -body {
|
||||
~ 0 0
|
||||
} -returnCodes error -result "wrong # args: should be \"~ integer\""
|
||||
@@ -310,10 +310,10 @@ namespace eval ::testmathop {
|
||||
} -returnCodes error -result "wrong # args: should be \"~ integer\""
|
||||
test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
|
||||
~ 0.0
|
||||
} -result {can't use floating-point value as operand of "~"}
|
||||
} -result {can't use floating-point value "0.0" as operand of "~"}
|
||||
test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
|
||||
~ NaN
|
||||
} -result {can't use non-numeric floating-point value as operand of "~"}
|
||||
} -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
|
||||
set op ~
|
||||
test mathop-4.13 {interpreted ~} {$op 0} -1
|
||||
test mathop-4.14 {interpreted ~} {$op 1} -2
|
||||
@@ -324,7 +324,7 @@ namespace eval ::testmathop {
|
||||
test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
|
||||
test mathop-4.20 {interpreted ~: errors} -body {
|
||||
$op foobar
|
||||
} -returnCodes error -result {can't use non-numeric string as operand of "~"}
|
||||
} -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
|
||||
test mathop-4.21 {interpreted ~: errors} -body {
|
||||
$op 0 0
|
||||
} -returnCodes error -result "wrong # args: should be \"~ integer\""
|
||||
@@ -333,10 +333,10 @@ namespace eval ::testmathop {
|
||||
} -returnCodes error -result "wrong # args: should be \"~ integer\""
|
||||
test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
|
||||
$op 0.0
|
||||
} -result {can't use floating-point value as operand of "~"}
|
||||
} -result {can't use floating-point value "0.0" as operand of "~"}
|
||||
test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
|
||||
$op NaN
|
||||
} -result {can't use non-numeric floating-point value as operand of "~"}
|
||||
} -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
|
||||
|
||||
test mathop-5.1 {compiled eq} {eq {} a} 0
|
||||
test mathop-5.2 {compiled eq} {eq a a} 1
|
||||
@@ -377,32 +377,32 @@ namespace eval ::testmathop {
|
||||
test mathop-6.4 {compiled &} { & 3 7 6 } 2
|
||||
test mathop-6.5 {compiled &} -returnCodes error -body {
|
||||
& 1.0 2 3
|
||||
} -result {can't use floating-point value as operand of "&"}
|
||||
} -result {can't use floating-point value "1.0" as operand of "&"}
|
||||
test mathop-6.6 {compiled &} -returnCodes error -body {
|
||||
& 1 2 3.0
|
||||
} -result {can't use floating-point value as operand of "&"}
|
||||
} -result {can't use floating-point value "3.0" as operand of "&"}
|
||||
test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
|
||||
test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
|
||||
test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
|
||||
test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
|
||||
test mathop-6.11 {compiled &: errors} -returnCodes error -body {
|
||||
& x 0
|
||||
} -result {can't use non-numeric string as operand of "&"}
|
||||
} -result {can't use non-numeric string "x" as operand of "&"}
|
||||
test mathop-6.12 {compiled &: errors} -returnCodes error -body {
|
||||
& nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "&"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
|
||||
test mathop-6.13 {compiled &: errors} -returnCodes error -body {
|
||||
& 0 x
|
||||
} -result {can't use non-numeric string as operand of "&"}
|
||||
} -result {can't use non-numeric string "x" as operand of "&"}
|
||||
test mathop-6.14 {compiled &: errors} -returnCodes error -body {
|
||||
& 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "&"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
|
||||
test mathop-6.15 {compiled &: errors} -returnCodes error -body {
|
||||
& 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "&"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "&"}
|
||||
test mathop-6.16 {compiled &: errors} -returnCodes error -body {
|
||||
& 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "&"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "&"}
|
||||
test mathop-6.17 {compiled &: errors} -returnCodes error -body {
|
||||
& 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -419,32 +419,32 @@ namespace eval ::testmathop {
|
||||
test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
|
||||
test mathop-6.23 {interpreted &} -returnCodes error -body {
|
||||
$op 1.0 2 3
|
||||
} -result {can't use floating-point value as operand of "&"}
|
||||
} -result {can't use floating-point value "1.0" as operand of "&"}
|
||||
test mathop-6.24 {interpreted &} -returnCodes error -body {
|
||||
$op 1 2 3.0
|
||||
} -result {can't use floating-point value as operand of "&"}
|
||||
} -result {can't use floating-point value "3.0" as operand of "&"}
|
||||
test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
|
||||
test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
|
||||
test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
|
||||
test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
|
||||
test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
|
||||
$op x 0
|
||||
} -result {can't use non-numeric string as operand of "&"}
|
||||
} -result {can't use non-numeric string "x" as operand of "&"}
|
||||
test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
|
||||
$op nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "&"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
|
||||
test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
|
||||
$op 0 x
|
||||
} -result {can't use non-numeric string as operand of "&"}
|
||||
} -result {can't use non-numeric string "x" as operand of "&"}
|
||||
test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
|
||||
$op 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "&"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "&"}
|
||||
test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
|
||||
$op 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "&"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "&"}
|
||||
test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
|
||||
$op 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "&"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "&"}
|
||||
test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
|
||||
$op 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -487,32 +487,32 @@ namespace eval ::testmathop {
|
||||
test mathop-7.4 {compiled |} { | 3 7 6 } 7
|
||||
test mathop-7.5 {compiled |} -returnCodes error -body {
|
||||
| 1.0 2 3
|
||||
} -result {can't use floating-point value as operand of "|"}
|
||||
} -result {can't use floating-point value "1.0" as operand of "|"}
|
||||
test mathop-7.6 {compiled |} -returnCodes error -body {
|
||||
| 1 2 3.0
|
||||
} -result {can't use floating-point value as operand of "|"}
|
||||
} -result {can't use floating-point value "3.0" as operand of "|"}
|
||||
test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
|
||||
test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
|
||||
test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
|
||||
test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
|
||||
test mathop-7.11 {compiled |: errors} -returnCodes error -body {
|
||||
| x 0
|
||||
} -result {can't use non-numeric string as operand of "|"}
|
||||
} -result {can't use non-numeric string "x" as operand of "|"}
|
||||
test mathop-7.12 {compiled |: errors} -returnCodes error -body {
|
||||
| nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "|"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
|
||||
test mathop-7.13 {compiled |: errors} -returnCodes error -body {
|
||||
| 0 x
|
||||
} -result {can't use non-numeric string as operand of "|"}
|
||||
} -result {can't use non-numeric string "x" as operand of "|"}
|
||||
test mathop-7.14 {compiled |: errors} -returnCodes error -body {
|
||||
| 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "|"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
|
||||
test mathop-7.15 {compiled |: errors} -returnCodes error -body {
|
||||
| 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "|"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "|"}
|
||||
test mathop-7.16 {compiled |: errors} -returnCodes error -body {
|
||||
| 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "|"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "|"}
|
||||
test mathop-7.17 {compiled |: errors} -returnCodes error -body {
|
||||
| 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -529,32 +529,32 @@ namespace eval ::testmathop {
|
||||
test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
|
||||
test mathop-7.23 {interpreted |} -returnCodes error -body {
|
||||
$op 1.0 2 3
|
||||
} -result {can't use floating-point value as operand of "|"}
|
||||
} -result {can't use floating-point value "1.0" as operand of "|"}
|
||||
test mathop-7.24 {interpreted |} -returnCodes error -body {
|
||||
$op 1 2 3.0
|
||||
} -result {can't use floating-point value as operand of "|"}
|
||||
} -result {can't use floating-point value "3.0" as operand of "|"}
|
||||
test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
|
||||
test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
|
||||
test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
|
||||
test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
|
||||
test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
|
||||
$op x 0
|
||||
} -result {can't use non-numeric string as operand of "|"}
|
||||
} -result {can't use non-numeric string "x" as operand of "|"}
|
||||
test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
|
||||
$op nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "|"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
|
||||
test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
|
||||
$op 0 x
|
||||
} -result {can't use non-numeric string as operand of "|"}
|
||||
} -result {can't use non-numeric string "x" as operand of "|"}
|
||||
test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
|
||||
$op 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "|"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "|"}
|
||||
test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
|
||||
$op 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "|"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "|"}
|
||||
test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
|
||||
$op 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "|"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "|"}
|
||||
test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
|
||||
$op 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -597,32 +597,32 @@ namespace eval ::testmathop {
|
||||
test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
|
||||
test mathop-8.5 {compiled ^} -returnCodes error -body {
|
||||
^ 1.0 2 3
|
||||
} -result {can't use floating-point value as operand of "^"}
|
||||
} -result {can't use floating-point value "1.0" as operand of "^"}
|
||||
test mathop-8.6 {compiled ^} -returnCodes error -body {
|
||||
^ 1 2 3.0
|
||||
} -result {can't use floating-point value as operand of "^"}
|
||||
} -result {can't use floating-point value "3.0" as operand of "^"}
|
||||
test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
|
||||
test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
|
||||
test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
|
||||
test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
|
||||
test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
|
||||
^ x 0
|
||||
} -result {can't use non-numeric string as operand of "^"}
|
||||
} -result {can't use non-numeric string "x" as operand of "^"}
|
||||
test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
|
||||
^ nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "^"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
|
||||
test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
|
||||
^ 0 x
|
||||
} -result {can't use non-numeric string as operand of "^"}
|
||||
} -result {can't use non-numeric string "x" as operand of "^"}
|
||||
test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
|
||||
^ 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "^"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
|
||||
test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
|
||||
^ 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "^"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "^"}
|
||||
test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
|
||||
^ 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "^"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "^"}
|
||||
test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
|
||||
^ 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -639,32 +639,32 @@ namespace eval ::testmathop {
|
||||
test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
|
||||
test mathop-8.23 {interpreted ^} -returnCodes error -body {
|
||||
$op 1.0 2 3
|
||||
} -result {can't use floating-point value as operand of "^"}
|
||||
} -result {can't use floating-point value "1.0" as operand of "^"}
|
||||
test mathop-8.24 {interpreted ^} -returnCodes error -body {
|
||||
$op 1 2 3.0
|
||||
} -result {can't use floating-point value as operand of "^"}
|
||||
} -result {can't use floating-point value "3.0" as operand of "^"}
|
||||
test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
|
||||
test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
|
||||
test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
|
||||
test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
|
||||
test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op x 0
|
||||
} -result {can't use non-numeric string as operand of "^"}
|
||||
} -result {can't use non-numeric string "x" as operand of "^"}
|
||||
test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op nan 0
|
||||
} -result {can't use non-numeric floating-point value as operand of "^"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
|
||||
test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op 0 x
|
||||
} -result {can't use non-numeric string as operand of "^"}
|
||||
} -result {can't use non-numeric string "x" as operand of "^"}
|
||||
test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op 0 nan
|
||||
} -result {can't use non-numeric floating-point value as operand of "^"}
|
||||
} -result {can't use non-numeric floating-point value "nan" as operand of "^"}
|
||||
test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op 0o8 0
|
||||
} -result {can't use invalid octal number as operand of "^"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "^"}
|
||||
test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op 0 0o8
|
||||
} -result {can't use invalid octal number as operand of "^"}
|
||||
} -result {can't use non-numeric string "0o8" as operand of "^"}
|
||||
test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
|
||||
$op 0 [error expectedError]
|
||||
} -result expectedError
|
||||
@@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } {
|
||||
# skipping - for now, knownbug...
|
||||
foreach op {+ * / & | ^ **} {
|
||||
lappend res [TestOp $op {*}$vals]
|
||||
lappend exp "can't use non-numeric string as operand of \"$op\"\
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\
|
||||
ARITH DOMAIN {non-numeric string}"
|
||||
}
|
||||
}
|
||||
foreach op {+ * / & | ^ **} {
|
||||
lappend res [TestOp $op NaN 1]
|
||||
lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
|
||||
lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\
|
||||
ARITH DOMAIN {non-numeric floating-point value}"
|
||||
}
|
||||
expr {$res eq $exp ? 0 : $res}
|
||||
@@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } {
|
||||
set res {}
|
||||
set exp {}
|
||||
lappend res [TestOp / x]
|
||||
lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp - x]
|
||||
lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp ~ x]
|
||||
lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp ! x]
|
||||
lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp ~ 5.0]
|
||||
lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
|
||||
lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}"
|
||||
expr {$res eq $exp ? 0 : $res}
|
||||
} 0
|
||||
test mathop-21.6 { unary ops, too many } {
|
||||
@@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } {
|
||||
set exp {}
|
||||
foreach op {& | ^} {
|
||||
lappend res [TestOp $op x 5]
|
||||
lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp $op 5 x]
|
||||
lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
}
|
||||
expr {$res eq $exp ? 0 : $res}
|
||||
} 0
|
||||
@@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } {
|
||||
set exp {}
|
||||
foreach op {% << >>} {
|
||||
lappend res [TestOp $op x 1]
|
||||
lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp $op 1 x]
|
||||
lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
|
||||
}
|
||||
foreach op {% << >>} {
|
||||
lappend res [TestOp $op 5.0 1]
|
||||
lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
|
||||
lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
|
||||
lappend res [TestOp $op 1 5.0]
|
||||
lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
|
||||
lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
|
||||
}
|
||||
foreach op {in ni} {
|
||||
lappend res [TestOp $op 5 "a b \{ c"]
|
||||
@@ -1240,9 +1240,9 @@ test mathop-25.23 { exp operator errors } {
|
||||
lappend res [TestOp ** $huge 2.1]
|
||||
lappend exp "Inf"
|
||||
lappend res [TestOp ** 2 foo]
|
||||
lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend res [TestOp ** foo 2]
|
||||
lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
|
||||
lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
|
||||
|
||||
expr {$res eq $exp ? 0 : $res}
|
||||
} 0
|
||||
|
||||
+1
-1
@@ -12,7 +12,7 @@
|
||||
# Note that after running these tests, entries will be left behind in the
|
||||
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.
|
||||
|
||||
package require Tcl 8.2
|
||||
package require Tcl 8.2-
|
||||
if {[catch {package require tcltest 2}]} {
|
||||
puts stderr "Skipping tests in [info script]. tcltest 2 required."
|
||||
return
|
||||
|
||||
@@ -1045,9 +1045,8 @@ test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
|
||||
} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
|
||||
|
||||
test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
|
||||
catch {testexprparser 08 -1} m o
|
||||
dict get $o -errorcode
|
||||
} -result {TCL PARSE EXPR BADNUMBER OCTAL}
|
||||
testexprparser 08 -1
|
||||
} -result {- {} 0 subexpr 08 1 text 08 0 {}}
|
||||
test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
|
||||
catch {testexprparser 0o8 -1} m o
|
||||
dict get $o -errorcode
|
||||
|
||||
+1
-1
@@ -10,7 +10,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution of
|
||||
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require Tcl 8.5
|
||||
package require Tcl 8.5-
|
||||
|
||||
if {[lsearch [namespace children] ::tcltest] == -1} {
|
||||
package require tcltest 2
|
||||
|
||||
+2
-2
@@ -280,10 +280,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} {
|
||||
} 0
|
||||
test string-5.17 {string index, bad integer} -body {
|
||||
list [catch {string index "abc" 0o8} msg] $msg
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test string-5.18 {string index, bad integer} -body {
|
||||
list [catch {string index "abc" end-0o0289} msg] $msg
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test string-5.19 {string index, bytearray object out of bounds} {
|
||||
string index [binary format I* {0x50515253 0x52}] -1
|
||||
} {}
|
||||
|
||||
@@ -339,11 +339,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering}
|
||||
test stringComp-5.17 {string index, bad integer} -body {
|
||||
proc foo {} {string index "abc" 0o8}
|
||||
list [catch {foo} msg] $msg
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test stringComp-5.18 {string index, bad integer} -body {
|
||||
proc foo {} {string index "abc" end-0o0289}
|
||||
list [catch {foo} msg] $msg
|
||||
} -match glob -result {1 {*invalid octal number*}}
|
||||
} -match glob -result {1 {*}}
|
||||
test stringComp-5.19 {string index, bytearray object out of bounds} {
|
||||
proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
|
||||
foo
|
||||
|
||||
+1
-1
@@ -6,7 +6,7 @@
|
||||
# Copyright (c) 2004 by Donal K. Fellows.
|
||||
# All rights reserved.
|
||||
|
||||
package require Tcl 8.5
|
||||
package require Tcl 8.5-
|
||||
if {"::tcltest" ni [namespace children]} {
|
||||
package require tcltest 2
|
||||
namespace import -force ::tcltest::*
|
||||
|
||||
@@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} {
|
||||
test while-old-4.4 {errors in while loops} {
|
||||
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
|
||||
list $err $msg
|
||||
} {1 {can't use non-numeric string as operand of "+"}}
|
||||
} {1 {can't use non-numeric string "a" as operand of "+"}}
|
||||
test while-old-4.5 {errors in while loops} {
|
||||
catch {unset x}
|
||||
set x 1
|
||||
|
||||
+2
-2
@@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
|
||||
} -match glob -result {*"while {$i<} break"}
|
||||
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
|
||||
while {"a"+"b"} {error "loop aborted"}
|
||||
} -returnCodes error -result {can't use non-numeric string as operand of "+"}
|
||||
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
|
||||
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
|
||||
set value 1
|
||||
while {($tcl_platform(platform) != "foobar1") && \
|
||||
@@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body {
|
||||
test while-4.4 {while (not compiled): error in test expression} -body {
|
||||
set z while
|
||||
$z {"a"+"b"} {error "loop aborted"}
|
||||
} -returnCodes error -result {can't use non-numeric string as operand of "+"}
|
||||
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
|
||||
test while-4.5 {while (not compiled): multiline test expr} -body {
|
||||
set value 1
|
||||
set z while
|
||||
|
||||
+1
-1
@@ -10,7 +10,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require Tcl 8.4
|
||||
package require Tcl 8.4-
|
||||
|
||||
namespace eval genStubs {
|
||||
# libraryName --
|
||||
|
||||
+1
-1
@@ -2,7 +2,7 @@
|
||||
# \
|
||||
exec tclsh "$0" ${1+"$@"}
|
||||
|
||||
package require Tcl 8.4
|
||||
package require Tcl 8.4-
|
||||
|
||||
# man2html.tcl --
|
||||
#
|
||||
|
||||
+1
-1
@@ -5,7 +5,7 @@
|
||||
#
|
||||
# Copyright (c) 1996 by Sun Microsystems, Inc.
|
||||
|
||||
package require Tcl 8.4
|
||||
package require Tcl 8.4-
|
||||
|
||||
# Global variables used by these scripts:
|
||||
#
|
||||
|
||||
+1
-1
@@ -6,7 +6,7 @@
|
||||
#
|
||||
# Copyright (c) 1996 by Sun Microsystems, Inc.
|
||||
|
||||
package require Tcl 8.4
|
||||
package require Tcl 8.4-
|
||||
|
||||
# Global variables used by these scripts:
|
||||
#
|
||||
|
||||
+2
-2
@@ -5,9 +5,9 @@ HCW=0
|
||||
LCID=0x409 0x0 0x0 ;English (United States)
|
||||
REPORT=Yes
|
||||
TITLE=Tcl/Tk Reference Manual
|
||||
CNT=tcl86.cnt
|
||||
CNT=tcl90.cnt
|
||||
COPYRIGHT=Copyright © 2000 Ajuba Solutions
|
||||
HLP=tcl86.hlp
|
||||
HLP=tcl90.hlp
|
||||
|
||||
[FILES]
|
||||
tcl.rtf
|
||||
|
||||
+1
-1
@@ -30,7 +30,7 @@
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
#----------------------------------------------------------------------
|
||||
|
||||
package require Tcl 8.5
|
||||
package require Tcl 8.5-
|
||||
|
||||
# Define the names of the Olson files that we need to load.
|
||||
# We avoid the solar time files and the leap seconds.
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
#!/usr/bin/env tclsh
|
||||
|
||||
package require Tcl 8.6
|
||||
package require Tcl 8.6-
|
||||
|
||||
# Convert Ousterhout format man pages into highly crosslinked hypertext.
|
||||
#
|
||||
|
||||
Vendored
+13
-13
@@ -1,6 +1,6 @@
|
||||
#! /bin/sh
|
||||
# Guess values for system-dependent variables and create Makefiles.
|
||||
# Generated by GNU Autoconf 2.59 for tcl 8.6.
|
||||
# Generated by GNU Autoconf 2.59 for tcl 9.0.
|
||||
#
|
||||
# Copyright (C) 2003 Free Software Foundation, Inc.
|
||||
# This configure script is free software; the Free Software Foundation
|
||||
@@ -267,8 +267,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
|
||||
# Identity of this package.
|
||||
PACKAGE_NAME='tcl'
|
||||
PACKAGE_TARNAME='tcl'
|
||||
PACKAGE_VERSION='8.6'
|
||||
PACKAGE_STRING='tcl 8.6'
|
||||
PACKAGE_VERSION='9.0'
|
||||
PACKAGE_STRING='tcl 9.0'
|
||||
PACKAGE_BUGREPORT=''
|
||||
|
||||
# Factoring default headers for most tests.
|
||||
@@ -777,7 +777,7 @@ if test "$ac_init_help" = "long"; then
|
||||
# Omit some internal or obsolete options to make the list less imposing.
|
||||
# This message is too long to be a string in the A/UX 3.1 sh.
|
||||
cat <<_ACEOF
|
||||
\`configure' configures tcl 8.6 to adapt to many kinds of systems.
|
||||
\`configure' configures tcl 9.0 to adapt to many kinds of systems.
|
||||
|
||||
Usage: $0 [OPTION]... [VAR=VALUE]...
|
||||
|
||||
@@ -834,7 +834,7 @@ fi
|
||||
|
||||
if test -n "$ac_init_help"; then
|
||||
case $ac_init_help in
|
||||
short | recursive ) echo "Configuration of tcl 8.6:";;
|
||||
short | recursive ) echo "Configuration of tcl 9.0:";;
|
||||
esac
|
||||
cat <<\_ACEOF
|
||||
|
||||
@@ -978,7 +978,7 @@ fi
|
||||
test -n "$ac_init_help" && exit 0
|
||||
if $ac_init_version; then
|
||||
cat <<\_ACEOF
|
||||
tcl configure 8.6
|
||||
tcl configure 9.0
|
||||
generated by GNU Autoconf 2.59
|
||||
|
||||
Copyright (C) 2003 Free Software Foundation, Inc.
|
||||
@@ -992,7 +992,7 @@ cat >&5 <<_ACEOF
|
||||
This file contains any messages produced by compilers while
|
||||
running configure, to aid debugging if configure makes a mistake.
|
||||
|
||||
It was created by tcl $as_me 8.6, which was
|
||||
It was created by tcl $as_me 9.0, which was
|
||||
generated by GNU Autoconf 2.59. Invocation command line was
|
||||
|
||||
$ $0 $@
|
||||
@@ -1332,10 +1332,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
|
||||
|
||||
|
||||
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL="b3"
|
||||
TCL_VERSION=9.0
|
||||
TCL_MAJOR_VERSION=9
|
||||
TCL_MINOR_VERSION=0
|
||||
TCL_PATCH_LEVEL="a0"
|
||||
VERSION=${TCL_VERSION}
|
||||
|
||||
#------------------------------------------------------------------------
|
||||
@@ -19958,7 +19958,7 @@ _ASBOX
|
||||
} >&5
|
||||
cat >&5 <<_CSEOF
|
||||
|
||||
This file was extended by tcl $as_me 8.6, which was
|
||||
This file was extended by tcl $as_me 9.0, which was
|
||||
generated by GNU Autoconf 2.59. Invocation command line was
|
||||
|
||||
CONFIG_FILES = $CONFIG_FILES
|
||||
@@ -20016,7 +20016,7 @@ _ACEOF
|
||||
|
||||
cat >>$CONFIG_STATUS <<_ACEOF
|
||||
ac_cs_version="\\
|
||||
tcl config.status 8.6
|
||||
tcl config.status 9.0
|
||||
configured by $0, generated by GNU Autoconf 2.59,
|
||||
with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
|
||||
|
||||
|
||||
+5
-5
@@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
|
||||
dnl generate the file "configure", which is run during Tcl installation
|
||||
dnl to configure the system for the local environment.
|
||||
|
||||
AC_INIT([tcl],[8.6])
|
||||
AC_INIT([tcl],[9.0])
|
||||
AC_PREREQ(2.59)
|
||||
|
||||
dnl This is only used when included from macosx/configure.ac
|
||||
@@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
|
||||
#endif /* _TCLCONFIG */])
|
||||
])
|
||||
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL="b3"
|
||||
TCL_VERSION=9.0
|
||||
TCL_MAJOR_VERSION=9
|
||||
TCL_MINOR_VERSION=0
|
||||
TCL_PATCH_LEVEL="a0"
|
||||
VERSION=${TCL_VERSION}
|
||||
|
||||
#------------------------------------------------------------------------
|
||||
|
||||
+1
-1
@@ -4,7 +4,7 @@
|
||||
|
||||
Name: tcl
|
||||
Summary: Tcl scripting language development environment
|
||||
Version: 8.6b3
|
||||
Version: 9.0a0
|
||||
Release: 2
|
||||
License: BSD
|
||||
Group: Development/Languages
|
||||
|
||||
+2
-2
@@ -150,9 +150,9 @@ Tcl_AppInit(
|
||||
*/
|
||||
|
||||
#ifdef DJGPP
|
||||
(Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
|
||||
(Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclsh.rc", TCL_GLOBAL_ONLY);
|
||||
#else
|
||||
(Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
|
||||
(Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/.tclshrc", TCL_GLOBAL_ONLY);
|
||||
#endif
|
||||
|
||||
return TCL_OK;
|
||||
|
||||
@@ -19,18 +19,6 @@
|
||||
#define TM_YEAR_BASE 1900
|
||||
#define IsLeapYear(x) (((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0))
|
||||
|
||||
/*
|
||||
* TclpGetDate is coded to return a pointer to a 'struct tm'. For thread
|
||||
* safety, this structure must be in thread-specific data. The 'tmKey'
|
||||
* variable is the key to this buffer.
|
||||
*/
|
||||
|
||||
static Tcl_ThreadDataKey tmKey;
|
||||
typedef struct ThreadSpecificData {
|
||||
struct tm gmtime_buf;
|
||||
struct tm localtime_buf;
|
||||
} ThreadSpecificData;
|
||||
|
||||
/*
|
||||
* If we fall back on the thread-unsafe versions of gmtime and localtime, use
|
||||
* this mutex to try to protect them.
|
||||
@@ -248,114 +236,6 @@ Tcl_GetTime(
|
||||
tclGetTimeProcPtr(timePtr, tclTimeClientData);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpGetDate --
|
||||
*
|
||||
* This function converts between seconds and struct tm. If useGMT is
|
||||
* true, then the returned date will be in Greenwich Mean Time (GMT).
|
||||
* Otherwise, it will be in the local time zone.
|
||||
*
|
||||
* Results:
|
||||
* Returns a static tm structure.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
struct tm *
|
||||
TclpGetDate(
|
||||
const time_t *time,
|
||||
int useGMT)
|
||||
{
|
||||
if (useGMT) {
|
||||
return TclpGmtime(time);
|
||||
} else {
|
||||
return TclpLocaltime(time);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpGmtime --
|
||||
*
|
||||
* Wrapper around the 'gmtime' library function to make it thread safe.
|
||||
*
|
||||
* Results:
|
||||
* Returns a pointer to a 'struct tm' in thread-specific data.
|
||||
*
|
||||
* Side effects:
|
||||
* Invokes gmtime or gmtime_r as appropriate.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
struct tm *
|
||||
TclpGmtime(
|
||||
const time_t *timePtr) /* Pointer to the number of seconds since the
|
||||
* local system's epoch */
|
||||
{
|
||||
/*
|
||||
* Get a thread-local buffer to hold the returned time.
|
||||
*/
|
||||
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey);
|
||||
|
||||
#ifdef HAVE_GMTIME_R
|
||||
gmtime_r(timePtr, &tsdPtr->gmtime_buf);
|
||||
#else
|
||||
Tcl_MutexLock(&tmMutex);
|
||||
memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm));
|
||||
Tcl_MutexUnlock(&tmMutex);
|
||||
#endif
|
||||
|
||||
return &tsdPtr->gmtime_buf;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpLocaltime --
|
||||
*
|
||||
* Wrapper around the 'localtime' library function to make it thread
|
||||
* safe.
|
||||
*
|
||||
* Results:
|
||||
* Returns a pointer to a 'struct tm' in thread-specific data.
|
||||
*
|
||||
* Side effects:
|
||||
* Invokes localtime or localtime_r as appropriate.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
struct tm *
|
||||
TclpLocaltime(
|
||||
const time_t *timePtr) /* Pointer to the number of seconds since the
|
||||
* local system's epoch */
|
||||
{
|
||||
/*
|
||||
* Get a thread-local buffer to hold the returned time.
|
||||
*/
|
||||
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey);
|
||||
|
||||
SetTZIfNecessary();
|
||||
#ifdef HAVE_LOCALTIME_R
|
||||
localtime_r(timePtr, &tsdPtr->localtime_buf);
|
||||
#else
|
||||
Tcl_MutexLock(&tmMutex);
|
||||
memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm));
|
||||
Tcl_MutexUnlock(&tmMutex);
|
||||
#endif
|
||||
|
||||
return &tsdPtr->localtime_buf;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+2
-2
@@ -1,4 +1,4 @@
|
||||
Tcl 8.6 for Windows
|
||||
Tcl 9.0 for Windows
|
||||
|
||||
1. Introduction
|
||||
---------------
|
||||
@@ -16,7 +16,7 @@ The information in this file is maintained on the web at:
|
||||
|
||||
In order to compile Tcl for Windows, you need the following:
|
||||
|
||||
Tcl 8.6 Source Distribution (plus any patches)
|
||||
Tcl 9.0 Source Distribution (plus any patches)
|
||||
|
||||
and
|
||||
|
||||
|
||||
Vendored
+4
-4
@@ -1308,10 +1308,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
|
||||
# /bin/sh. The bash shell seems to suffer from some strange failures.
|
||||
SHELL=/bin/sh
|
||||
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL="b3"
|
||||
TCL_VERSION=9.0
|
||||
TCL_MAJOR_VERSION=9
|
||||
TCL_MINOR_VERSION=0
|
||||
TCL_PATCH_LEVEL="a0"
|
||||
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
|
||||
|
||||
TCL_DDE_VERSION=1.4
|
||||
|
||||
+4
-4
@@ -11,10 +11,10 @@ AC_PREREQ(2.59)
|
||||
# /bin/sh. The bash shell seems to suffer from some strange failures.
|
||||
SHELL=/bin/sh
|
||||
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL="b3"
|
||||
TCL_VERSION=9.0
|
||||
TCL_MAJOR_VERSION=9
|
||||
TCL_MINOR_VERSION=0
|
||||
TCL_PATCH_LEVEL="a0"
|
||||
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
|
||||
|
||||
TCL_DDE_VERSION=1.4
|
||||
|
||||
+2
-2
@@ -123,8 +123,8 @@ CFG_ENCODING = \"cp1252\"
|
||||
|
||||
NAMEPREFIX = tcl
|
||||
STUBPREFIX = $(NAMEPREFIX)stub
|
||||
DOTVERSION = 8.6
|
||||
VERSION = 86
|
||||
DOTVERSION = 9.0
|
||||
VERSION = 90
|
||||
|
||||
DDEVERSION = 14
|
||||
DDEDOTVERSION = 1.4
|
||||
|
||||
+1
-1
@@ -193,7 +193,7 @@ Tcl_AppInit(
|
||||
* specific startup file will be run under any conditions.
|
||||
*/
|
||||
|
||||
(Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
|
||||
(Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -157,7 +157,7 @@ int
|
||||
Dde_Init(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
if (!Tcl_InitStubs(interp, "8.1", 0)) {
|
||||
if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -165,7 +165,7 @@ Registry_Init(
|
||||
{
|
||||
Tcl_Command cmd;
|
||||
|
||||
if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
|
||||
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
@@ -12,35 +12,12 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#define SECSPERDAY (60L * 60L * 24L)
|
||||
#define SECSPERYEAR (SECSPERDAY * 365L)
|
||||
#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY)
|
||||
|
||||
/*
|
||||
* Number of samples over which to estimate the performance counter.
|
||||
*/
|
||||
|
||||
#define SAMPLES 64
|
||||
|
||||
/*
|
||||
* The following arrays contain the day of year for the last day of each
|
||||
* month, where index 1 is January.
|
||||
*/
|
||||
|
||||
static const int normalDays[] = {
|
||||
-1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
|
||||
};
|
||||
|
||||
static const int leapDays[] = {
|
||||
-1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
|
||||
};
|
||||
|
||||
typedef struct ThreadSpecificData {
|
||||
char tzName[64]; /* Time zone name */
|
||||
struct tm tm; /* time information */
|
||||
} ThreadSpecificData;
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
|
||||
/*
|
||||
* Data for managing high-resolution timers.
|
||||
*/
|
||||
@@ -113,7 +90,6 @@ static TimeInfo timeInfo = {
|
||||
* Declarations for functions defined later in this file.
|
||||
*/
|
||||
|
||||
static struct tm * ComputeGMT(const time_t *tp);
|
||||
static void StopCalibration(ClientData clientData);
|
||||
static DWORD WINAPI CalibrationThread(LPVOID arg);
|
||||
static void UpdateTimeEachSecond(void);
|
||||
@@ -486,227 +462,6 @@ StopCalibration(
|
||||
CloseHandle(timeInfo.calibrationThread);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpGetDate --
|
||||
*
|
||||
* This function converts between seconds and struct tm. If useGMT is
|
||||
* true, then the returned date will be in Greenwich Mean Time (GMT).
|
||||
* Otherwise, it will be in the local time zone.
|
||||
*
|
||||
* Results:
|
||||
* Returns a static tm structure.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
struct tm *
|
||||
TclpGetDate(
|
||||
const time_t *t,
|
||||
int useGMT)
|
||||
{
|
||||
struct tm *tmPtr;
|
||||
time_t time;
|
||||
|
||||
if (!useGMT) {
|
||||
tzset();
|
||||
|
||||
/*
|
||||
* If we are in the valid range, let the C run-time library handle it.
|
||||
* Otherwise we need to fake it. Note that this algorithm ignores
|
||||
* daylight savings time before the epoch.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Hm, Borland's localtime manages to return NULL under certain
|
||||
* circumstances (e.g. wintime.test, test 1.2). Nobody tests for this,
|
||||
* since 'localtime' isn't supposed to do this, possibly leading to
|
||||
* crashes.
|
||||
*
|
||||
* Patch: We only call this function if we are at least one day into
|
||||
* the epoch, else we handle it ourselves (like we do for times < 0).
|
||||
* H. Giese, June 2003
|
||||
*/
|
||||
|
||||
#ifdef __BORLANDC__
|
||||
#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY
|
||||
#else
|
||||
#define LOCALTIME_VALIDITY_BOUNDARY 0
|
||||
#endif
|
||||
|
||||
if (*t >= LOCALTIME_VALIDITY_BOUNDARY) {
|
||||
return TclpLocaltime(t);
|
||||
}
|
||||
|
||||
time = *t - timezone;
|
||||
|
||||
/*
|
||||
* If we aren't near to overflowing the long, just add the bias and
|
||||
* use the normal calculation. Otherwise we will need to adjust the
|
||||
* result at the end.
|
||||
*/
|
||||
|
||||
if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) {
|
||||
tmPtr = ComputeGMT(&time);
|
||||
} else {
|
||||
tmPtr = ComputeGMT(t);
|
||||
|
||||
tzset();
|
||||
|
||||
/*
|
||||
* Add the bias directly to the tm structure to avoid overflow.
|
||||
* Propagate seconds overflow into minutes, hours and days.
|
||||
*/
|
||||
|
||||
time = tmPtr->tm_sec - timezone;
|
||||
tmPtr->tm_sec = (int)(time % 60);
|
||||
if (tmPtr->tm_sec < 0) {
|
||||
tmPtr->tm_sec += 60;
|
||||
time -= 60;
|
||||
}
|
||||
|
||||
time = tmPtr->tm_min + time/60;
|
||||
tmPtr->tm_min = (int)(time % 60);
|
||||
if (tmPtr->tm_min < 0) {
|
||||
tmPtr->tm_min += 60;
|
||||
time -= 60;
|
||||
}
|
||||
|
||||
time = tmPtr->tm_hour + time/60;
|
||||
tmPtr->tm_hour = (int)(time % 24);
|
||||
if (tmPtr->tm_hour < 0) {
|
||||
tmPtr->tm_hour += 24;
|
||||
time -= 24;
|
||||
}
|
||||
|
||||
time /= 24;
|
||||
tmPtr->tm_mday += (int)time;
|
||||
tmPtr->tm_yday += (int)time;
|
||||
tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7;
|
||||
}
|
||||
} else {
|
||||
tmPtr = ComputeGMT(t);
|
||||
}
|
||||
return tmPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* ComputeGMT --
|
||||
*
|
||||
* This function computes GMT given the number of seconds since the epoch
|
||||
* (midnight Jan 1 1970).
|
||||
*
|
||||
* Results:
|
||||
* Returns a (per thread) statically allocated struct tm.
|
||||
*
|
||||
* Side effects:
|
||||
* Updates the values of the static struct tm.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static struct tm *
|
||||
ComputeGMT(
|
||||
const time_t *tp)
|
||||
{
|
||||
struct tm *tmPtr;
|
||||
long tmp, rem;
|
||||
int isLeap;
|
||||
const int *days;
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
tmPtr = &tsdPtr->tm;
|
||||
|
||||
/*
|
||||
* Compute the 4 year span containing the specified time.
|
||||
*/
|
||||
|
||||
tmp = (long)(*tp / SECSPER4YEAR);
|
||||
rem = (long)(*tp % SECSPER4YEAR);
|
||||
|
||||
/*
|
||||
* Correct for weird mod semantics so the remainder is always positive.
|
||||
*/
|
||||
|
||||
if (rem < 0) {
|
||||
tmp--;
|
||||
rem += SECSPER4YEAR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compute the year after 1900 by taking the 4 year span and adjusting for
|
||||
* the remainder. This works because 2000 is a leap year, and 1900/2100
|
||||
* are out of the range.
|
||||
*/
|
||||
|
||||
tmp = (tmp * 4) + 70;
|
||||
isLeap = 0;
|
||||
if (rem >= SECSPERYEAR) { /* 1971, etc. */
|
||||
tmp++;
|
||||
rem -= SECSPERYEAR;
|
||||
if (rem >= SECSPERYEAR) { /* 1972, etc. */
|
||||
tmp++;
|
||||
rem -= SECSPERYEAR;
|
||||
if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */
|
||||
tmp++;
|
||||
rem -= SECSPERYEAR + SECSPERDAY;
|
||||
} else {
|
||||
isLeap = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
tmPtr->tm_year = tmp;
|
||||
|
||||
/*
|
||||
* Compute the day of year and leave the seconds in the current day in the
|
||||
* remainder.
|
||||
*/
|
||||
|
||||
tmPtr->tm_yday = rem / SECSPERDAY;
|
||||
rem %= SECSPERDAY;
|
||||
|
||||
/*
|
||||
* Compute the time of day.
|
||||
*/
|
||||
|
||||
tmPtr->tm_hour = rem / 3600;
|
||||
rem %= 3600;
|
||||
tmPtr->tm_min = rem / 60;
|
||||
tmPtr->tm_sec = rem % 60;
|
||||
|
||||
/*
|
||||
* Compute the month and day of month.
|
||||
*/
|
||||
|
||||
days = (isLeap) ? leapDays : normalDays;
|
||||
for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) {
|
||||
/* empty body */
|
||||
}
|
||||
tmPtr->tm_mon = --tmp;
|
||||
tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
|
||||
|
||||
/*
|
||||
* Compute day of week. Epoch started on a Thursday.
|
||||
*/
|
||||
|
||||
tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4;
|
||||
if ((*tp % SECSPERDAY) < 0) {
|
||||
tmPtr->tm_wday--;
|
||||
}
|
||||
tmPtr->tm_wday %= 7;
|
||||
if (tmPtr->tm_wday < 0) {
|
||||
tmPtr->tm_wday += 7;
|
||||
}
|
||||
|
||||
return tmPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1034,67 +789,6 @@ AccumulateSample(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpGmtime --
|
||||
*
|
||||
* Wrapper around the 'gmtime' library function to make it thread safe.
|
||||
*
|
||||
* Results:
|
||||
* Returns a pointer to a 'struct tm' in thread-specific data.
|
||||
*
|
||||
* Side effects:
|
||||
* Invokes gmtime or gmtime_r as appropriate.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
struct tm *
|
||||
TclpGmtime(
|
||||
const time_t *timePtr) /* Pointer to the number of seconds since the
|
||||
* local system's epoch */
|
||||
{
|
||||
/*
|
||||
* The MS implementation of gmtime is thread safe because it returns the
|
||||
* time in a block of thread-local storage, and Windows does not provide a
|
||||
* Posix gmtime_r function.
|
||||
*/
|
||||
|
||||
return gmtime(timePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpLocaltime --
|
||||
*
|
||||
* Wrapper around the 'localtime' library function to make it thread
|
||||
* safe.
|
||||
*
|
||||
* Results:
|
||||
* Returns a pointer to a 'struct tm' in thread-specific data.
|
||||
*
|
||||
* Side effects:
|
||||
* Invokes localtime or localtime_r as appropriate.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
struct tm *
|
||||
TclpLocaltime(
|
||||
const time_t *timePtr) /* Pointer to the number of seconds since the
|
||||
* local system's epoch */
|
||||
{
|
||||
/*
|
||||
* The MS implementation of localtime is thread safe because it returns
|
||||
* the time in a block of thread-local storage, and Windows does not
|
||||
* provide a Posix localtime_r function.
|
||||
*/
|
||||
|
||||
return localtime(timePtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
Reference in New Issue
Block a user