diff options
| -rw-r--r-- | doc/SetResult.3 | 239 | ||||
| -rw-r--r-- | generic/tclBinary.c | 2 | ||||
| -rw-r--r-- | generic/tclDecls.h | 36 | ||||
| -rw-r--r-- | generic/tclIO.c | 20 | ||||
| -rw-r--r-- | generic/tclObj.c | 7 | ||||
| -rw-r--r-- | generic/tclResult.c | 37 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 2 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 22 | ||||
| -rwxr-xr-x | unix/configure | 2 |
9 files changed, 143 insertions, 224 deletions
diff --git a/doc/SetResult.3 b/doc/SetResult.3 index 42e3ce0..94990d7 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -34,213 +34,108 @@ const char * .SH ARGUMENTS .AS Tcl_FreeProc sourceInterp out .AP Tcl_Interp *interp out -Interpreter whose result is to be modified or read. +The interpreter get or set the result for. .AP Tcl_Obj *objPtr in -Tcl value to become result for \fIinterp\fR. +A value to set the result to. .AP char *result in -String value to become result for \fIinterp\fR or to be -appended to the existing result. +The string value set the result to, or to append to the existing result. .AP "const char" *element in -String value to append as a list element +The string value to append as a list element to the existing result of \fIinterp\fR. .AP Tcl_FreeProc *freeProc in -Address of procedure to call to release storage at -\fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or -\fBTCL_VOLATILE\fR. +Pointer to a procedure to call to release storage at +\fIresult\fR. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. .AP Tcl_Interp *sourceInterp in -Interpreter that the result and return options should be transferred from. +The interpreter to transfer the result and return options from. .AP Tcl_Interp *targetInterp in -Interpreter that the result and return options should be transferred to. +The interpreter to transfer the result and return options to. .AP int code in Return code value that controls transfer of return options. .BE .SH DESCRIPTION .PP -The procedures described here are utilities for manipulating the -result value in a Tcl interpreter. -The interpreter result may be either a Tcl value or a string. -For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR -set the interpreter result to, respectively, a value and a string. -Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR -return the interpreter result as a value and as a string. -The procedures always keep the string and value forms -of the interpreter result consistent. -For example, if \fBTcl_SetObjResult\fR is called to set -the result to a value, -then \fBTcl_GetStringResult\fR is called, -it will return the value's string representation. +These procedures manipulate the result of an interpreter. Some procedures +provide a Tcl_Obj interface while others provide a string interface. For +example, \fBTcl_SetObjResult\fR accepts a Tcl_Obj and \fBTcl_SetResult\fR +accepts a char *. Similarly, \fBTcl_GetObjResult\fR produces a Tcl_Obj * and +\fBTcl_GetStringResult\fR produces a char *. The procedures can be mixed and +matched. For example, if \fBTcl_SetObjResult\fR is called to set the result to +a Tcl_Obj value, and then \fBTcl_GetStringResult\fR is called, it returns a +char * (but see caveats below). .PP -\fBTcl_SetObjResult\fR -arranges for \fIobjPtr\fR to be the result for \fIinterp\fR, +\fBTcl_SetObjResult\fR sets \fIobjPtr\fR as the result for \fIinterp\fR, replacing any existing result. -The result is left pointing to the value -referenced by \fIobjPtr\fR. -\fIobjPtr\fR's reference count is incremented -since there is now a new reference to it from \fIinterp\fR. -The reference count for any old result value -is decremented and the old result value is freed if no -references to it remain. .PP -\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as a value. -The value's reference count is not incremented; -if the caller needs to retain a long-term pointer to the value -they should use \fBTcl_IncrRefCount\fR to increment its reference count -in order to keep it from being freed too early or accidentally changed. -.PP -\fBTcl_SetResult\fR -arranges for \fIresult\fR to be the result for the current Tcl -command in \fIinterp\fR, replacing any existing result. -The \fIfreeProc\fR argument specifies how to manage the storage -for the \fIresult\fR argument; -it is discussed in the section -\fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below. -If \fIresult\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored -and \fBTcl_SetResult\fR -re-initializes \fIinterp\fR's result to point to an empty string. -.PP -\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string. -If the result was set to a value by a \fBTcl_SetObjResult\fR call, -the value form will be converted to a string and returned. -If the value's string representation contains null bytes, -this conversion will lose information. -For this reason, programmers are encouraged to -write their code to use the new value API procedures -and to call \fBTcl_GetObjResult\fR instead. -.PP -\fBTcl_ResetResult\fR clears the result for \fIinterp\fR -and leaves the result in its normal empty initialized state. -If the result is a value, -its reference count is decremented and the result is left -pointing to an unshared value representing an empty string. -If the result is a dynamically allocated string, its memory is free*d -and the result is left as a empty string. -\fBTcl_ResetResult\fR also clears the error state managed by -\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR, -and \fBTcl_SetErrorCode\fR. -.PP -\fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces. -It takes each of its \fIresult\fR arguments and appends them in order -to the current result associated with \fIinterp\fR. -If the result is in its initialized empty state (e.g. a command procedure -was just invoked or \fBTcl_ResetResult\fR was just called), -then \fBTcl_AppendResult\fR sets the result to the concatenation of -its \fIresult\fR arguments. -\fBTcl_AppendResult\fR may be called repeatedly as additional pieces -of the result are produced. -\fBTcl_AppendResult\fR takes care of all the -storage management issues associated with managing \fIinterp\fR's -result, such as allocating a larger result area if necessary. -It also manages conversion to and from the \fIresult\fR field of the -\fIinterp\fR so as to handle backward-compatibility with old-style -extensions. -Any number of \fIresult\fR arguments may be passed in a single -call; the last argument in the list must be a NULL pointer. -.PP -\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR -to \fItargetInterp\fR. The two interpreters must have been created in the -same thread. If \fIsourceInterp\fR and \fItargetInterp\fR are the same, -nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result -from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result -in \fIsourceInterp\fR. It also moves the return options dictionary as -controlled by the return code value \fIcode\fR in the same manner +\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR, without +incrementing its reference count. +.PP +\fBTcl_SetResult\fR sets \fIresult\fR as the result for \fIinterp\fR, replacing +any existing result, and calls \fIfreeProc\fR to free \fIresult\fR. See \fBTHE +TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below. If \fIresult\fR is +\fBNULL\fR, ignores \fIfreeProc\fR and sets the result for \fIinterp\fR to +point to the empty string. +.PP +\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string, i.e. +the bytes of the Tcl_Obj for the result, which can be decoded using +\fBTcl_UtfToExternal\fR. This value is freed when its corresponding Tcl_Obj is +freed.Programmers are encouraged to use the newer Tcl_Obj API procedures, e.g. +to call \fBTcl_GetObjResult\fR instead. +.PP +\fBTcl_ResetResult\fR sets the empty string as the result for \fIinterp\fR and +clears the error state managed by \fBTcl_AddErrorInfo\fR, +\fBTcl_AddObjErrorInfo\fR, and \fBTcl_SetErrorCode\fR. +.PP +\fBTcl_AppendResult\fR builds up a result from smaller pieces, appending each +\fIresult\fR in order to the current result for \fIinterp\fR. It may be called +repeatedly as additional pieces of the result are produced, and manages the +storage for the \fIinterp\fR's result, allocating a larger result area if +necessary. It also manages conversion to and from the \fIresult\fR field of +the \fIinterp\fR to handle backward-compatibility with old-style extensions. +Any number of \fIresult\fR arguments may be passed in a single call; the last +argument in the list must be a NULL pointer. +.PP +\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR to +\fItargetInterp\fR, both of which must have been created in the same thread, +resets the result in \fIsourceInterp\fR, and moves the return options +dictionary as controlled by the return code value \fIcode\fR in the same manner as \fBTcl_GetReturnOptions\fR. +.PP +If \fIsourceInterp\fR and \fItargetInterp\fR are the same, nothing is done. .SH "DEPRECATED INTERFACES" .SS "OLD STRING PROCEDURES" .PP -Use of the following procedures is deprecated -since they manipulate the Tcl result as a string. -Procedures such as \fBTcl_SetObjResult\fR -that manipulate the result as a value -can be significantly more efficient. -.PP -\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in -that it allows results to be built up in pieces. -However, \fBTcl_AppendElement\fR takes only a single \fIelement\fR -argument and it appends that argument to the current result -as a proper Tcl list element. -\fBTcl_AppendElement\fR adds backslashes or braces if necessary -to ensure that \fIinterp\fR's result can be parsed as a list and that -\fIelement\fR will be extracted as a single element. -Under normal conditions, \fBTcl_AppendElement\fR will add a space -character to \fIinterp\fR's result just before adding the new -list element, so that the list elements in the result are properly -separated. -However if the new list element is the first in a list or sub-list -(i.e. \fIinterp\fR's current result is empty, or consists of the -single character +The following procedures are deprecated since they manipulate the Tcl result as +a string. Procedures such as \fBTcl_SetObjResult\fR can be significantly more +efficient. +.PP +\fBTcl_AppendElement\fR is like \fBTcl_AppendResult\fR, but it appends only one +piece, and also appends that piece as a list item. +\fBTcl_AppendElement\fR adds backslashes or braces as necessary to ensure that +f\Ielement\fR is properly formatted as a list item. Under normal conditions, +\fBTcl_AppendElement\fR adds a space character to \fIinterp\fR's result just +before adding the new list element, so that the list elements in the result are +properly separated. However if the new list element is the first item in the +list or sublist (i.e. \fIinterp\fR's current result is empty, or consists of +the single character .QW { , or ends in the characters .QW " {" ) then no space is added. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP -\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how -the Tcl system is to manage the storage for the \fIresult\fR argument. -If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called -at a time when \fIinterp\fR holds a string result, -they do whatever is necessary to dispose of the old string result -(see the \fBTcl_Interp\fR manual entry for details on this). -.PP -If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIresult\fR -refers to an area of static storage that is guaranteed not to be -modified until at least the next call to \fBTcl_Eval\fR. -If \fIfreeProc\fR -is \fBTCL_DYNAMIC\fR it means that \fIresult\fR was allocated with a call -to \fBTcl_Alloc\fR and is now the property of the Tcl system. -\fBTcl_SetResult\fR will arrange for the string's storage to be -released by calling \fBTcl_Free\fR when it is no longer needed. -If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIresult\fR -points to an area of memory that is likely to be overwritten when -\fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame). -In this case \fBTcl_SetResult\fR will make a copy of the string in -dynamically allocated storage and arrange for the copy to be the -result for the current Tcl command. -.PP -If \fIfreeProc\fR is not one of the values \fBTCL_STATIC\fR, -\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address -of a procedure that Tcl should call to free the string. -This allows applications to use non-standard storage allocators. -When Tcl no longer needs the storage for the string, it will -call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and -result that match the type \fBTcl_FreeProc\fR: +\fIFreeProc\fR has the following type: .PP .CS typedef void \fBTcl_FreeProc\fR( char *\fIblockPtr\fR); .CE .PP -When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to -the value of \fIresult\fR passed to \fBTcl_SetResult\fR. +When \fIfreeProc\fR is called, \fIblockPtr\fR is the \fIresult\fR value passed +to \fBTcl_SetResult\fR. -.SH "REFERENCE COUNT MANAGEMENT" -.PP -The interpreter result is one of the main places that owns references to -values, along with the bytecode execution stack, argument lists, variables, -and the list and dictionary collection values. -.PP -\fBTcl_SetObjResult\fR takes a value with an arbitrary reference count -\fI(specifically including zero)\fR and guarantees to increment the reference -count. If code wishes to continue using the value after setting it as the -result, it should add its own reference to it with \fBTcl_IncrRefCount\fR. -.PP -\fBTcl_GetObjResult\fR returns the current interpreter result value. This will -have a reference count of at least 1. If the caller wishes to keep the -interpreter result value, it should increment its reference count. -.PP -\fBTcl_GetStringResult\fR does not manipulate reference counts, but the string -it returns is owned by (and has a lifetime controlled by) the current -interpreter result value; it should be copied instead of being relied upon to -persist after the next Tcl API call, as most Tcl operations can modify the -interpreter result. -.PP -\fBTcl_SetResult\fR, \fBTcl_AppendResult\fR, \fBTcl_AppendResultVA\fR, -\fBTcl_AppendElement\fR, and \fBTcl_ResetResult\fR all modify the interpreter -result. They may cause the old interpreter result to have its reference count -decremented and a new interpreter result to be allocated. After they have been -called, the reference count of the interpreter result is guaranteed to be 1. .SH "SEE ALSO" Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp, Tcl_GetReturnOptions diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 37dc921..70ea1c2 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -378,6 +378,7 @@ Tcl_GetBytesFromObj( return baPtr->bytes; } +#if !defined(TCL_NO_DEPRECATED) unsigned char * TclGetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ @@ -405,6 +406,7 @@ TclGetBytesFromObj( } return bytes; } +#endif /* *---------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 99661f4..7b66110 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4022,19 +4022,31 @@ extern const TclStubs *tclStubsPtr; Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL) #define Tcl_GetUnicode(objPtr) \ Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL) -#undef Tcl_GetBytesFromObj +#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) +# undef Tcl_GetBytesFromObj +# undef Tcl_GetStringFromObj +# undef Tcl_GetUnicodeFromObj +#endif #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean -#undef Tcl_GetStringFromObj -#undef Tcl_GetUnicodeFromObj #undef TclGetByteArrayFromObj #undef Tcl_GetByteArrayFromObj #if defined(USE_TCL_STUBS) -#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr))) +# if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) +# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr))) +# define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)(void *)(sizePtr))) +# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (size_t *)(void *)(sizePtr))) +# endif #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) @@ -4044,10 +4056,6 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)(void *)(sizePtr))) #if TCL_MAJOR_VERSION > 8 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ @@ -4059,10 +4067,6 @@ extern const TclStubs *tclStubsPtr; tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (size_t *)(void *)(sizePtr))) #endif -#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (size_t *)(void *)(sizePtr))) #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ @@ -4201,7 +4205,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) -#if !defined(BUILD_tcl) +#if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ : (Tcl_ListObjGetElements)((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) diff --git a/generic/tclIO.c b/generic/tclIO.c index df27807..b8137a7 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4870,11 +4870,11 @@ Tcl_GetsObj( && GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { /* Set eol to the position that caused the encoding error, and then - * coninue to gotEOL, which stores the data that was decoded + * continue to gotEOL, which stores the data that was decoded * without error to objPtr. This allows the caller to do something * useful with the data decoded so far, and also results in the * position of the file being the first byte that was not - * succesfully decoded, allowing further processing at exactly that + * successfully decoded, allowing further processing at exactly that * point, if desired. */ eol = dstEnd; @@ -5980,7 +5980,6 @@ DoReadChars( chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); - binaryMode = (encoding == GetBinaryEncoding()) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); @@ -5997,7 +5996,6 @@ DoReadChars( } } - /* * Must clear the BLOCKED|EOF flags here since we check before reading. */ @@ -6040,11 +6038,7 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && !GotFlag(statePtr, CHANNEL_STICKY_EOF) - && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - /* Channel is blocking. Return an error so that callers - * like [read] can return an error. - */ - Tcl_SetErrno(EILSEQ); + && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) { goto finish; } } @@ -6089,7 +6083,7 @@ finish: } /* - * Regenerate the top channel, in case it was changed due to + * Regenerate chanPtr in case it was changed due to * self-modifying reflected transforms. */ @@ -6111,8 +6105,14 @@ finish: assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); + + /* This must comes after UpdateInterest(), which may set errno */ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { + /* Channel either is blocking or is nonblocking with no data + * succesfully red before the error. Return an error so that callers + * like [read] can also return an error. + */ Tcl_SetErrno(EILSEQ); if (!copied) { copied = -1; diff --git a/generic/tclObj.c b/generic/tclObj.c index b923efb..e27f36e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -346,9 +346,9 @@ typedef struct ResolvedCmdName { * structure can be freed when refCount * becomes zero. */ } ResolvedCmdName; - + #ifdef TCL_MEM_DEBUG -/* +/* * Filler matches the value used for filling freed memory in tclCkalloc. * On 32-bit systems, the ref counts do not cross 0x7fffffff. On 64-bit * implementations, ref counts will never reach this value (unless explicitly @@ -1665,7 +1665,7 @@ Tcl_GetString( *---------------------------------------------------------------------- */ -#undef TclGetStringFromObj +#if !defined(TCL_NO_DEPRECATED) char * TclGetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should @@ -1708,6 +1708,7 @@ TclGetStringFromObj( } return objPtr->bytes; } +#endif /* !defined(TCL_NO_DEPRECATED) */ #undef Tcl_GetStringFromObj char * diff --git a/generic/tclResult.c b/generic/tclResult.c index 6a36fdf..7ca8271 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -10,6 +10,7 @@ */ #include "tclInt.h" +#include <assert.h> /* * Indices of the standard return options dictionary keys. @@ -211,40 +212,36 @@ Tcl_DiscardInterpState( *---------------------------------------------------------------------- * * Tcl_SetObjResult -- - * - * Arrange for objPtr to be an interpreter's result value. + * Makes objPtr the interpreter's result value. * * Results: * None. * * Side effects: - * interp->objResultPtr is left pointing to the object referenced by - * objPtr. The object's reference count is incremented since there is now - * a new reference to it. The reference count for any old objResultPtr - * value is decremented. Also, the string result is reset. + * Stores objPtr interp->objResultPtr, increments its reference count, and + * decrements the reference count of any existing interp->objResultPtr. + * + * The string result is reset. * *---------------------------------------------------------------------- */ void Tcl_SetObjResult( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return object value. */ - Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj - * result is made an empty string object. */ + Tcl_Interp *interp, /* Interpreter to set the result for. */ + Tcl_Obj *objPtr) /* The value to set as the result. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldObjResult = iPtr->objResultPtr; - - iPtr->objResultPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ - - /* - * We wait until the end to release the old object result, in case we are - * setting the result to itself. - */ - - TclDecrRefCount(oldObjResult); + if (objPtr == oldObjResult) { + /* This should be impossible */ + assert(objPtr->refCount != 0); + return; + } else { + iPtr->objResultPtr = objPtr; + Tcl_IncrRefCount(objPtr); + TclDecrRefCount(oldObjResult); + } } /* diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c3ab0ea..bb2cddf 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -672,6 +672,7 @@ TclGetUniChar( */ #undef Tcl_GetUnicodeFromObj +#if !defined(TCL_NO_DEPRECATED) Tcl_UniChar * TclGetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the Unicode string @@ -699,6 +700,7 @@ TclGetUnicodeFromObj( } return stringPtr->unicode; } +#endif /* !defined(TCL_NO_DEPRECATED) */ Tcl_UniChar * Tcl_GetUnicodeFromObj( diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 05f0ac7..22d769d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -76,8 +76,16 @@ #undef Tcl_UniCharLen #undef TclObjInterpProc #if !defined(_WIN32) && !defined(__CYGWIN__) -#undef Tcl_WinConvertError -#define Tcl_WinConvertError 0 +# undef Tcl_WinConvertError +# define Tcl_WinConvertError 0 +#endif +#if defined(TCL_NO_DEPRECATED) +# undef TclGetStringFromObj +# undef TclGetBytesFromObj +# undef TclGetUnicodeFromObj +# define TclGetStringFromObj 0 +# define TclGetBytesFromObj 0 +# define TclGetUnicodeFromObj 0 #endif #undef Tcl_Close #define Tcl_Close 0 @@ -103,6 +111,15 @@ static void uniCodePanic() { #define TclUtfNext Tcl_UtfNext #define TclUtfPrev Tcl_UtfPrev +#if defined(TCL_NO_DEPRECATED) +# define TclListObjGetElements 0 +# define TclListObjLength 0 +# define TclDictObjSize 0 +# define TclSplitList 0 +# define TclSplitPath 0 +# define TclFSSplitPath 0 +# define TclParseArgsObjv 0 +#else /* !defined(TCL_NO_DEPRECATED) */ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr) { size_t n = TCL_INDEX_NONE; @@ -196,6 +213,7 @@ int TclParseArgsObjv(Tcl_Interp *interp, *objcPtr = (int)n; return result; } +#endif /* !defined(TCL_NO_DEPRECATED) */ #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d diff --git a/unix/configure b/unix/configure index 9e810ab..4c54fbe 100755 --- a/unix/configure +++ b/unix/configure @@ -8105,7 +8105,7 @@ fi done # Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really -# define USEGETWD even if the Posix getcwd exists. Add a test ? +# define USEGETWD even if the posix getcwd exists. Add a test ? ac_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp" if test "x$ac_cv_func_mkstemp" = xyes |