diff options
95 files changed, 796 insertions, 3609 deletions
@@ -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. diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index ae595f1..0477c88 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -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 diff --git a/doc/Backslash.3 b/doc/Backslash.3 deleted file mode 100644 index 8b399fc..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -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 diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index a248cf4..d8ee2cc 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -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 diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 deleted file mode 100644 index cdde20b..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -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 diff --git a/doc/DString.3 b/doc/DString.3 index a85b1cf..9f097ab 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -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. @@ -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, diff --git a/doc/GetInt.3 b/doc/GetInt.3 index f77d337..795a5b1 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -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 diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 5fd9b9c..984f56a 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -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, diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index 44888f6..4629f1e 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.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) diff --git a/doc/RecordEval.3 b/doc/RecordEval.3 index a29f974..2bd5581 100644 --- a/doc/RecordEval.3 +++ b/doc/RecordEval.3 @@ -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 diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index e38ba2f..1ab5384 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -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 diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index 0155a61..0000000 --- a/doc/case.n +++ /dev/null @@ -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 @@ -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 @@ -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 diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 14b448e..a9b8a94 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -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 @@ -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" } diff --git a/generic/regcustom.h b/generic/regcustom.h index 1c970ea..309203a 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -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 diff --git a/generic/regex.h b/generic/regex.h index d6d46ce..d09857c 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -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 @@ -144,16 +140,6 @@ 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 =====^!^===== */ diff --git a/generic/tcl.decls b/generic/tcl.decls index 1829249..818f713 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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) diff --git a/generic/tcl.h b/generic/tcl.h index 049499c..c7b9e6a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -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 @@ -244,19 +239,6 @@ extern "C" { #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; @@ -692,28 +613,14 @@ typedef struct stat *Tcl_OldStat_; #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. */ struct Tcl_Obj; +typedef struct Tcl_Obj Tcl_Value; + /* *---------------------------------------------------------------------------- * Function types defined by Tcl: @@ -726,10 +633,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 +659,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 +671,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 +777,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 +903,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 @@ -1124,17 +1022,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 +1304,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 +1379,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 +1577,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); @@ -2422,6 +2309,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, @@ -2606,33 +2494,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 */ /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 562cca6..24a1082 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -41,18 +41,6 @@ #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 * cancellation requests, including the original interp, asynchronous handler @@ -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, @@ -2432,13 +2404,6 @@ TclInvokeObjectCommand( } /* - * 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. */ @@ -3430,360 +3395,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; -} - -/* - *---------------------------------------------------------------------- - * * TclInterpReady -- * * Check if an interpreter is ready to eval commands or scripts, i.e., if @@ -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; @@ -4825,54 +4421,6 @@ Tcl_EvalTokensStandard( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalEx, TclEvalEx -- * * This function evaluates a Tcl script without using the compiler or @@ -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. @@ -6942,42 +6441,6 @@ Tcl_VarEval( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetRecursionLimit -- * * Set the maximum number of recursive calls that may be active for an diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 14951e4..ee1f97a 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -132,143 +132,6 @@ Tcl_BreakObjCmd( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2801102..e12e969 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2b5f713..cb1864c40 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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); } diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b10d423..c44ba4c 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -75,13 +75,6 @@ Tcl_RecordAndEval( 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. */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 0cb9fa9..5bd0e2a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7059,47 +7059,6 @@ Tcl_Tell( /* *--------------------------------------------------------------------------- * - * 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); -} - -/* - *--------------------------------------------------------------------------- - * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. @@ -9006,18 +8965,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. */ Tcl_Channel inChan, /* Channel to read from. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 005713d..2b3e805 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -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 diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index ab08353..8773cb6 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -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. */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8f8b992..7b77579 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -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) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 1d04c82..90f283c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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. @@ -1878,19 +1867,6 @@ typedef struct Interp { * 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[]); diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index df5ac97..bf6a21d 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -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 */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index f265e7e..c1531f3 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -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 diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 5cacab1..ec1c617 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -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; } diff --git a/generic/tclMain.c b/generic/tclMain.c index f445383..73989ef 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -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); diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..b8f9c92 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -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; } /* @@ -314,39 +275,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); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); + if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { + return; } - - /* - * 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); - } + if (freeProc == TCL_DYNAMIC) { + ckfree(result); + } else { + (*freeProc)(result); } - - /* - * 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; - - /* - * 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); - } - - /* - * 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_Obj *elementPtr = Tcl_NewStringObj(element, -1); + Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); + int length; + const char *bytes; + + 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); } - - 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) { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 2d534a68..2287a16 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -18,13 +18,6 @@ #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 * uniquely determined by radix and by the widths of significand and exponent. @@ -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); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0bede56..7106d3d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -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 */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 12652a5..e875bf7 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -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 + = "This interpreter does not support stubs-enabled extensions."; + iPtr->legacyFreeProc = TCL_STATIC; return NULL; } @@ -96,9 +123,9 @@ TclInitStubs( */ if (magic != TCL_STUB_MAGIC || major != TCL_MAJOR_VERSION) { - iPtr->result = + iPtr->legacyResult = (char *) "extension linked to incompatible stubs library"; - iPtr->freeProc = TCL_STATIC; + iPtr->legacyFreeProc = TCL_STATIC; return NULL; } @@ -119,9 +146,9 @@ TclInitStubs( } if (isDigit(*q)) { badVersion: - iPtr->result = + iPtr->legacyResult = (char *) "extension passed bad version argument to stubs library"; - iPtr->freeProc = TCL_STATIC; + iPtr->legacyFreeProc = TCL_STATIC; return NULL; } @@ -182,26 +209,6 @@ TclInitStubs( } /* - * This routine is included only so that extensions compiled against - * 8.5 and earlier headers (which do not define Tcl_InitStubs() as a macro) - * can successfully link to libtclstubs8.6.a. This leaves them suffering - * from the formerly broken design. (See Tcl Bug 3588687). - * - * This routine should not merge forward to Tcl 9 work. Extensions - * compiled against 8.5 and earlier headers that try to link to - * libtclstubs9*.a should suffer the link failure. - */ -#undef Tcl_InitStubs -MODULE_SCOPE const char * -Tcl_InitStubs( - Tcl_Interp *interp, - const char *version, - int exact) -{ - return TclInitStubs(interp, version, exact, 8, TCL_STUB_MAGIC); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclTest.c b/generic/tclTest.c index a8b27fb..ff3ec2c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -116,13 +116,6 @@ typedef struct TclEncoding { } 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) { @@ -3302,144 +3282,6 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean @@ -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... */ } /* diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 22b5995..c1828bb 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -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); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 13e54ec..4b69628 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1556,40 +1556,6 @@ Tcl_Merge( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null @@ -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; - - 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); - } + int length; + char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); - 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); } @@ -3691,73 +3590,6 @@ SetEndOffsetFromAny( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. @@ -4108,31 +3940,6 @@ Tcl_GetNameOfExecutable(void) /* *---------------------------------------------------------------------- * - * 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); -} - -/* - *---------------------------------------------------------------------- - * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the diff --git a/generic/tclVar.c b/generic/tclVar.c index 1c01e41..d8a7141 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -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 diff --git a/library/http/http.tcl b/library/http/http.tcl index d57e3ce..c3290c9 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -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 diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 303d3bd..828c860 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -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}}}] diff --git a/library/init.tcl b/library/init.tcl index 3ec78af..7eeb53b 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -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: diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 112507a..5f8e1e9 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -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 diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 832bf81..a5b6499 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -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]] diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl index fc77fa1..163bc7d 100644 --- a/library/opt/optparse.tcl +++ b/library/opt/optparse.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 diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl index 107d4c6..d96af94 100644 --- a/library/opt/pkgIndex.tcl +++ b/library/opt/pkgIndex.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.2]} {return} +if {![package vsatisfies [package provide Tcl] 8.2-]} {return} package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 0e4568d..3769155 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.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]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 02da62f..12692bb 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -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, diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig index 9c47547..6ee8d58 100644 --- a/macosx/Tcl-Common.xcconfig +++ b/macosx/Tcl-Common.xcconfig @@ -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 diff --git a/tests/all.tcl b/tests/all.tcl index 05d3024..5fd21ce 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -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]] diff --git a/tests/assemble.test b/tests/assemble.test index 7d4e5d1..942b763 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -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 { diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index 6d63cea..0000000 --- a/tests/case.test +++ /dev/null @@ -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 diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 2ecf626..3011597 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -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?"} diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bae26a0..774060d 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -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} diff --git a/tests/compExpr.test b/tests/compExpr.test index 14c875d..a2a021e 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -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*} diff --git a/tests/compile.test b/tests/compile.test index 4d91940..d276460 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -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} diff --git a/tests/execute.test b/tests/execute.test index 94af158..e0b68e5 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -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 diff --git a/tests/expr-old.test b/tests/expr-old.test index 4f3cb2e..ed0f11f 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -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} diff --git a/tests/expr.test b/tests/expr.test index 6ad7208..29fb967 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -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}} diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 9c543dc..9d0650e 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -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]} { diff --git a/tests/lindex.test b/tests/lindex.test index b86e2e0..81f5c40 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -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 diff --git a/tests/main.test b/tests/main.test index f1dc7fd..7fd9d73 100644 --- a/tests/main.test +++ b/tests/main.test @@ -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} { diff --git a/tests/mathop.test b/tests/mathop.test index f122b7b..0808d42 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -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 diff --git a/tests/msgcat.test b/tests/msgcat.test index 1522354..9fb565b 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,7 +12,7 @@ # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. -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 diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 7910974..d667bf2 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -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 diff --git a/tests/safe.test b/tests/safe.test index 4a2792e..423e10e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 +package require Tcl 8.5- if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/string.test b/tests/string.test index f558d30..e9e6e6d 100644 --- a/tests/string.test +++ b/tests/string.test @@ -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 } {} diff --git a/tests/stringComp.test b/tests/stringComp.test index 9e00ce7..210f431 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -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 diff --git a/tests/tm.test b/tests/tm.test index 149a65d..73e8261 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -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::* diff --git a/tests/while-old.test b/tests/while-old.test index ee17d0b..e33bd0b 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -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 diff --git a/tests/while.test b/tests/while.test index 642ec93..c25b404 100644 --- a/tests/while.test +++ b/tests/while.test @@ -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 diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 93e0a9a..6ce4243 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -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 -- diff --git a/tools/man2html.tcl b/tools/man2html.tcl index fa57b03..124f631 100644 --- a/tools/man2html.tcl +++ b/tools/man2html.tcl @@ -2,7 +2,7 @@ # \ exec tclsh "$0" ${1+"$@"} -package require Tcl 8.4 +package require Tcl 8.4- # man2html.tcl -- # diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl index f2b2e43..23a9e58 100644 --- a/tools/man2html1.tcl +++ b/tools/man2html1.tcl @@ -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: # diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl index 163196e..753fde4 100644 --- a/tools/man2html2.tcl +++ b/tools/man2html2.tcl @@ -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: # diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 3bdccbe..4641165 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -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 diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index 005919a..d025d72 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -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. diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 665a1d4..b4c0f6c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -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. # diff --git a/unix/configure b/unix/configure index cbb10b4..82ca9df 100755 --- a/unix/configure +++ b/unix/configure @@ -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'`\\" diff --git a/unix/configure.in b/unix/configure.in index f4b695d..4ebf1af 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -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} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index 0c42aa4..f4839ce 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -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 diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 159bbd8..21dce71 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -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; diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index c7921fe..6e8c5f4 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -20,18 +20,6 @@ #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. */ @@ -251,114 +239,6 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -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 diff --git a/win/configure b/win/configure index 0258898..ba10113 100755 --- a/win/configure +++ b/win/configure @@ -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 diff --git a/win/configure.in b/win/configure.in index 0426bb1..e74a745 100644 --- a/win/configure.in +++ b/win/configure.in @@ -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 diff --git a/win/makefile.bc b/win/makefile.bc index 18bfa28..bd71169 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -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 diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 56f45a0..5ecebea 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -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; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d0600e6..5cf7d60 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -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; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 6ac5caf..dadfa2b 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -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; } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index daa229d..9cfbac0 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,10 +12,6 @@ #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. */ @@ -23,25 +19,6 @@ #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); @@ -489,227 +465,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -1037,67 +792,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); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the |