diff options
| -rw-r--r-- | compat/fake-rfc2553.c | 32 | ||||
| -rw-r--r-- | compat/fixstrtod.c | 2 | ||||
| -rw-r--r-- | compat/gettod.c | 2 | ||||
| -rw-r--r-- | compat/mkstemp.c | 2 | ||||
| -rw-r--r-- | compat/opendir.c | 2 | ||||
| -rw-r--r-- | compat/strncasecmp.c | 2 | ||||
| -rw-r--r-- | compat/strstr.c | 2 | ||||
| -rw-r--r-- | compat/strtod.c | 6 | ||||
| -rw-r--r-- | compat/strtol.c | 2 | ||||
| -rw-r--r-- | compat/strtoul.c | 6 | ||||
| -rw-r--r-- | compat/waitpid.c | 2 | ||||
| -rw-r--r-- | doc/source.n | 2 | ||||
| -rw-r--r-- | generic/tcl.h | 5 | ||||
| -rw-r--r-- | generic/tclBasic.c | 30 | ||||
| -rw-r--r-- | generic/tclCompile.c | 16 | ||||
| -rw-r--r-- | generic/tclExecute.c | 37 | ||||
| -rw-r--r-- | generic/tclIO.c | 53 | ||||
| -rw-r--r-- | generic/tclIOGT.c | 2 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclListObj.c | 4 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 12 | ||||
| -rw-r--r-- | generic/tclOOCall.c | 2 | ||||
| -rw-r--r-- | generic/tclOOInt.h | 2 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 12 | ||||
| -rw-r--r-- | generic/tclObj.c | 4 | ||||
| -rw-r--r-- | generic/tclPreserve.c | 3 | ||||
| -rw-r--r-- | generic/tclProc.c | 5 | ||||
| -rw-r--r-- | generic/tclRegexp.c | 6 | ||||
| -rw-r--r-- | generic/tclStrToD.c | 2 | ||||
| -rw-r--r-- | generic/tclTrace.c | 20 | ||||
| -rw-r--r-- | generic/tclVar.c | 163 | ||||
| -rw-r--r-- | tests/execute.test | 9 |
32 files changed, 150 insertions, 303 deletions
diff --git a/compat/fake-rfc2553.c b/compat/fake-rfc2553.c index 3b91041..c8e69400 100644 --- a/compat/fake-rfc2553.c +++ b/compat/fake-rfc2553.c @@ -1,7 +1,7 @@ /* * Copyright (C) 2000-2003 Damien Miller. All rights reserved. * Copyright (C) 1999 WIDE Project. All rights reserved. - * + * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: @@ -13,7 +13,7 @@ * 3. Neither the name of the project nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. - * + * * THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE @@ -67,7 +67,7 @@ strlcpy(char *dst, const char *src, size_t siz) } #endif -int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, +int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, size_t hostlen, char *serv, size_t servlen, int flags) { struct sockaddr_in *sin = (struct sockaddr_in *)sa; @@ -96,7 +96,7 @@ int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, } else { int ret; Tcl_MutexLock(&netdbMutex); - hp = gethostbyaddr((char *)&sin->sin_addr, + hp = gethostbyaddr((char *)&sin->sin_addr, sizeof(struct in_addr), AF_INET); if (hp == NULL) { ret = EAI_NODATA; @@ -130,7 +130,7 @@ fake_gai_strerror(int err) default: return ("unknown/invalid error."); } -} +} #endif /* !HAVE_GAI_STRERROR */ #ifndef HAVE_FREEADDRINFO @@ -156,9 +156,9 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) ai = malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); if (ai == NULL) return (NULL); - + memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in)); - + ai->ai_addr = (struct sockaddr *)(ai + 1); /* XXX -- ssh doesn't use sa_len */ ai->ai_addrlen = sizeof(struct sockaddr_in); @@ -166,7 +166,7 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) ((struct sockaddr_in *)(ai)->ai_addr)->sin_port = port; ((struct sockaddr_in *)(ai)->ai_addr)->sin_addr.s_addr = addr; - + /* XXX: the following is not generally correct, but does what we want */ if (hints->ai_socktype) ai->ai_socktype = hints->ai_socktype; @@ -180,7 +180,7 @@ addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) } int -fake_getaddrinfo(const char *hostname, const char *servname, +fake_getaddrinfo(const char *hostname, const char *servname, const struct addrinfo *hints, struct addrinfo **res) { struct hostent *hp; @@ -211,29 +211,29 @@ fake_getaddrinfo(const char *hostname, const char *servname, if (hostname && inet_aton(hostname, &in) != 0) addr = in.s_addr; *res = malloc_ai(port, addr, hints); - if (*res == NULL) + if (*res == NULL) return (EAI_MEMORY); return (0); } - + if (!hostname) { *res = malloc_ai(port, htonl(0x7f000001), hints); - if (*res == NULL) + if (*res == NULL) return (EAI_MEMORY); return (0); } - + if (inet_aton(hostname, &in)) { *res = malloc_ai(port, in.s_addr, hints); - if (*res == NULL) + if (*res == NULL) return (EAI_MEMORY); return (0); } - + /* Don't try DNS if AI_NUMERICHOST is set */ if (hints && hints->ai_flags & AI_NUMERICHOST) return (EAI_NONAME); - + Tcl_MutexLock(&netdbMutex); hp = gethostbyname(hostname); if (hp && hp->h_name && hp->h_name[0] && hp->h_addr_list[0]) { diff --git a/compat/fixstrtod.c b/compat/fixstrtod.c index 91f309e..63fb8ef 100644 --- a/compat/fixstrtod.c +++ b/compat/fixstrtod.c @@ -1,4 +1,4 @@ -/* +/* * fixstrtod.c -- * * Source code for the "fixstrtod" procedure. This procedure is diff --git a/compat/gettod.c b/compat/gettod.c index 28e1432..ca20cf8 100644 --- a/compat/gettod.c +++ b/compat/gettod.c @@ -1,4 +1,4 @@ -/* +/* * gettod.c -- * * This file provides the gettimeofday function on systems diff --git a/compat/mkstemp.c b/compat/mkstemp.c index eaa0b66..1a44dfa 100644 --- a/compat/mkstemp.c +++ b/compat/mkstemp.c @@ -1,4 +1,4 @@ -/* +/* * mkstemp.c -- * * Source code for the "mkstemp" library routine. diff --git a/compat/opendir.c b/compat/opendir.c index a18f96b..22e8a3a 100644 --- a/compat/opendir.c +++ b/compat/opendir.c @@ -1,4 +1,4 @@ -/* +/* * opendir.c -- * * This file provides dirent-style directory-reading procedures for V7 diff --git a/compat/strncasecmp.c b/compat/strncasecmp.c index 299715d..0a69f35 100644 --- a/compat/strncasecmp.c +++ b/compat/strncasecmp.c @@ -1,4 +1,4 @@ -/* +/* * strncasecmp.c -- * * Source code for the "strncasecmp" library routine. diff --git a/compat/strstr.c b/compat/strstr.c index 6698c9f..e3b9b8d 100644 --- a/compat/strstr.c +++ b/compat/strstr.c @@ -1,4 +1,4 @@ -/* +/* * strstr.c -- * * Source code for the "strstr" library routine. diff --git a/compat/strtod.c b/compat/strtod.c index cb9f76d..9643c09 100644 --- a/compat/strtod.c +++ b/compat/strtod.c @@ -1,4 +1,4 @@ -/* +/* * strtod.c -- * * Source code for the "strtod" library procedure. @@ -137,7 +137,7 @@ strtod( * has more than 18 digits, ignore the extras, since they can't affect the * value anyway. */ - + pExp = p; p -= mantSize; if (decPt < 0) { @@ -217,7 +217,7 @@ strtod( * by processing the exponent one bit at a time to combine many powers of * 2 of 10. Then combine the exponent with the fraction. */ - + if (exp < 0) { expSign = TRUE; exp = -exp; diff --git a/compat/strtol.c b/compat/strtol.c index b111d97..811006a 100644 --- a/compat/strtol.c +++ b/compat/strtol.c @@ -1,4 +1,4 @@ -/* +/* * strtol.c -- * * Source code for the "strtol" library procedure. diff --git a/compat/strtoul.c b/compat/strtoul.c index d572c2b..15587f1 100644 --- a/compat/strtoul.c +++ b/compat/strtoul.c @@ -1,4 +1,4 @@ -/* +/* * strtoul.c -- * * Source code for the "strtoul" library procedure. @@ -90,7 +90,7 @@ strtoul( * If no base was provided, pick one from the leading characters of the * string. */ - + if (base == 0) { if (*p == '0') { p += 1; @@ -206,7 +206,7 @@ strtoul( if (overflow) { errno = ERANGE; return ULONG_MAX; - } + } if (negative) { return -result; } diff --git a/compat/waitpid.c b/compat/waitpid.c index 8f65799..e03275a 100644 --- a/compat/waitpid.c +++ b/compat/waitpid.c @@ -1,4 +1,4 @@ -/* +/* * waitpid.c -- * * This procedure emulates the POSIX waitpid kernel call on BSD systems diff --git a/doc/source.n b/doc/source.n index 9f488c5..67d4b6b 100644 --- a/doc/source.n +++ b/doc/source.n @@ -43,6 +43,8 @@ or which will be safely substituted by the Tcl interpreter into .QW ^Z . .PP +A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, unicode). +.PP The \fB\-encoding\fR option is used to specify the encoding of the data stored in \fIfileName\fR. When the \fB\-encoding\fR option is omitted, the system encoding is assumed. diff --git a/generic/tcl.h b/generic/tcl.h index f0d7c9a..1f7b5cb 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -816,7 +816,8 @@ typedef struct Tcl_Obj { union { /* The internal representation: */ long longValue; /* - an long integer value. */ double doubleValue; /* - a double-precision floating value. */ - void *otherValuePtr; /* - another, type-specific value. */ + void *otherValuePtr; /* - another, type-specific value, + not used internally any more. */ Tcl_WideInt wideValue; /* - a long long value. */ struct { /* - internal rep as two pointers. * the main use of which is a bignum's @@ -2509,7 +2510,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); # define Tcl_DecrRefCount(objPtr) \ do { \ Tcl_Obj *_objPtr = (objPtr); \ - if (--(_objPtr)->refCount <= 0) { \ + if ((_objPtr)->refCount-- <= 1) { \ TclFreeObj(_objPtr); \ } \ } while(0) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 1220239..c9b37b2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2260,7 +2260,7 @@ Tcl_CreateObjCommand( /* Command already exists. */ /* - * [***] This is wrong. See Tcl Bug a16752c252. + * [***] This is wrong. See Tcl Bug a16752c252. * However, this buggy behavior is kept under particular * circumstances to accommodate deployed binaries of the * "tclcompiler" program. http://sourceforge.net/projects/tclpro/ @@ -3084,7 +3084,7 @@ Tcl_DeleteCommandFromToken( while (tracePtr != NULL) { CommandTrace *nextPtr = tracePtr->nextPtr; - if ((--tracePtr->refCount) <= 0) { + if (tracePtr->refCount-- <= 1) { ckfree(tracePtr); } tracePtr = nextPtr; @@ -3270,7 +3270,7 @@ CallCommandTraces( tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; - if ((--tracePtr->refCount) <= 0) { + if (tracePtr->refCount-- <= 1) { ckfree(tracePtr); } } @@ -4144,7 +4144,7 @@ TclNREvalObjv( * data[1] stores a marker for use by tailcalls; it will be set to 1 by * command redirectors (imports, alias, ensembles) so that tailcall skips * this callback (that marks the end of the target command) and goes back - * to the end of the source command. + * to the end of the source command. */ if (iPtr->deferredCallbacks) { @@ -4172,7 +4172,7 @@ EvalObjvCore( Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; - + /* * Push records for task to be done on return, in INVERSE order. First, if * needed, the exception handlers (as they should happen last). @@ -4298,7 +4298,7 @@ EvalObjvCore( } } - /* + /* * Schedule leave traces. Raise the refCount on the resolved * cmdPtr, so that when it passes to the leave traces we know * it's still valid. @@ -4409,7 +4409,7 @@ NRCommand( /* * If there is a tailcall, schedule it next */ - + if (data[1] && (data[1] != INT2PTR(1))) { TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL); } @@ -5643,10 +5643,10 @@ TclArgumentBCEnter( * ensemble dispatch. Ensemble subcommands that lead to script * evaluation are not supposed to get compiled, because a command * such as [info level] in the script can expose some of the dispatch - * shenanigans. This means that we don't have to tend to the + * shenanigans. This means that we don't have to tend to the * housekeeping, and can escape now. */ - + if (ePtr->nline != objc) { return; } @@ -5910,7 +5910,7 @@ Tcl_GlobalEvalObj( * * If the flag TCL_EVAL_DIRECT is passed in, the value of invoker * must be NULL. Support for non-NULL invokers in that mode has - * been removed since it was unused and untested. Failure to + * been removed since it was unused and untested. Failure to * follow this limitation will lead to an assertion panic. * * Results: @@ -8192,7 +8192,7 @@ Tcl_NRCmdSwap( * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution * should continue after the CURRENT command is fully returned ("skip * the next command: we are redirecting to it, tailcalls should run - * after WE return") + * after WE return") * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse * this point. This is special for OO, as some of the oo constructs * that behave like commands may not push an NRCommand callback. @@ -8326,7 +8326,7 @@ TclNRTailcallObjCmd( /* The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ - + listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); @@ -8335,7 +8335,7 @@ TclNRTailcallObjCmd( Tcl_Panic("Tailcall failed to find the proper namespace"); } TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; @@ -8364,9 +8364,9 @@ TclNRTailcallEval( int objc; Tcl_Obj **objv; - Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); + Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; - + if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 98756ea..824276c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -356,7 +356,7 @@ InstructionDesc const tclInstructionTable[] = { /* Create the variables (described in the aux data referred to by the * second immediate argument) to mirror the state of the dictionary in * the variable referred to by the first immediate argument. The list - * of keys (top of the stack, not poppsed) must be the same length as + * of keys (top of the stack, not popped) must be the same length as * the list of variables. * Stack: ... keyList => ... keyList */ {"dictUpdateEnd", 9, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}}, @@ -518,7 +518,7 @@ InstructionDesc const tclInstructionTable[] = { * case. Also runs the whole-array trace on the named variable, so can * throw anything. * Stack: ... varName => ... boolean */ - {"arrayExistsImm", 5, +1, 1, {OPERAND_UINT4}}, + {"arrayExistsImm", 5, +1, 1, {OPERAND_LVT4}}, /* Looks up the variable indexed by opnd and tests whether it is an * array. Pushes a boolean describing whether this is the case. Also * runs the whole-array trace on the named variable, so can throw @@ -528,7 +528,7 @@ InstructionDesc const tclInstructionTable[] = { /* Forces the element on the top of the stack to be the name of an * array. * Stack: ... varName => ... */ - {"arrayMakeImm", 5, 0, 1, {OPERAND_UINT4}}, + {"arrayMakeImm", 5, 0, 1, {OPERAND_LVT4}}, /* Forces the variable indexed by opnd to be an array. Does not touch * the stack. */ @@ -1624,7 +1624,7 @@ TclFreeCompileEnv( envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { - /* + /* * We never converted to Bytecode, so free the things we would * have transferred to it. */ @@ -1856,7 +1856,7 @@ CompileExpanded( int wordIdx = 0; DefineLineInformation; int depth = TclGetStackDepth(envPtr); - + StartExpanding(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1905,7 +1905,7 @@ CompileExpanded( TclCheckStackDepth(depth+1, envPtr); } -static int +static int CompileCmdCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, @@ -2006,7 +2006,7 @@ CompileCommandTokens( int cmdIdx = envPtr->numCommands; int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); - + assert (parsePtr->numWords > 0); /* Pre-Compile */ @@ -4035,7 +4035,7 @@ TclEmitInvoke( int arg1, arg2, wordCount = 0, expandCount = 0; int loopRange = 0, breakRange = 0, continueRange = 0; int cleanup, depth = TclGetStackDepth(envPtr); - + /* * Parse the arguments. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6fc6b6b..d12a25c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1138,7 +1138,7 @@ GrowEvaluationStack( } needed = growth + moveWords + WALLOCALIGN; - + /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) @@ -1176,7 +1176,7 @@ GrowEvaluationStack( #else newElems = needed; #endif - + newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); oldPtr = esPtr; @@ -2152,7 +2152,7 @@ TEBCresume( const unsigned char *pc = data[1]; /* The current program counter. */ unsigned char inst; /* The currently running instruction */ - + /* * Transfer variables - needed only between opcodes, but not while * executing an instruction. @@ -2357,7 +2357,7 @@ TEBCresume( */ inst = *pc; - + peepholeStart: #ifdef TCL_COMPILE_STATS iPtr->stats.instructionCount[*pc]++; @@ -2377,7 +2377,7 @@ TEBCresume( #endif /* TCL_COMPILE_DEBUG */ TCL_DTRACE_INST_NEXT(); - + if (inst == INST_LOAD_SCALAR1) { goto instLoadScalar1; } else if (inst == INST_PUSH1) { @@ -2389,7 +2389,7 @@ TEBCresume( /* * Peephole: do not run INST_START_CMD, just skip it */ - + iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (checkInterp) { checkInterp = 0; @@ -2410,7 +2410,7 @@ TEBCresume( } goto peepholeStart; } - + switch (inst) { case INST_SYNTAX: case INST_RETURN_IMM: { @@ -2557,7 +2557,7 @@ TEBCresume( /* TIP #280: Record the last piece of info needed by * 'TclGetSrcInfoForPc', and push the frame. */ - + bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; @@ -5763,7 +5763,7 @@ TEBCresume( * at this point (post Tcl_GetUnicodeFromObj). */ - ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0; + ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0; } Tcl_InvalidateStringRep(objResultPtr); TclDecrRefCount(value3Ptr); @@ -5790,7 +5790,7 @@ TEBCresume( * at this point (post Tcl_GetUnicodeFromObj). */ - ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0; + ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0; } Tcl_InvalidateStringRep(valuePtr); TclDecrRefCount(value3Ptr); @@ -7111,7 +7111,7 @@ TEBCresume( */ TclNewObj(tmpPtr); - tmpPtr->internalRep.otherValuePtr = infoPtr; + tmpPtr->internalRep.twoPtrValue.ptr1 = infoPtr; PUSH_OBJECT(tmpPtr); /* infoPtr object */ TRACE_APPEND(("jump to loop step\n")); @@ -7129,7 +7129,7 @@ TEBCresume( */ tmpPtr = OBJ_AT_TOS; - infoPtr = tmpPtr->internalRep.otherValuePtr; + infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE(("=> ")); @@ -7213,7 +7213,7 @@ TEBCresume( case INST_FOREACH_END: /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */ tmpPtr = OBJ_AT_TOS; - infoPtr = tmpPtr->internalRep.otherValuePtr; + infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE(("=> loop terminated\n")); NEXT_INST_V(1, numLists+2, 0); @@ -7230,10 +7230,10 @@ TEBCresume( */ tmpPtr = OBJ_AT_DEPTH(1); - infoPtr = tmpPtr->internalRep.otherValuePtr; + infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists)); - + objPtr = OBJ_AT_DEPTH(3 + numLists); Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS); NEXT_INST_F(1, 1, 0); @@ -8195,7 +8195,7 @@ TEBCresume( } iPtr->cmdFramePtr = bcFramePtr->nextPtr; - if (--codePtr->refCount <= 0) { + if (codePtr->refCount-- <= 1) { TclCleanupByteCode(codePtr); } TclStackFree(interp, TD); /* free my stack */ @@ -9774,7 +9774,7 @@ ValidatePcAndStackTop( (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } - if (checkStack && + if (checkStack && ((stackTop < 0) || (stackTop > stackUpperBound))) { int numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); @@ -9904,7 +9904,6 @@ TclGetSourceFromFrame( cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); - cfPtr->cmd = Tcl_GetStringFromObj(cfPtr->cmdObj, &cfPtr->len); } Tcl_IncrRefCount(cfPtr->cmdObj); } @@ -9987,7 +9986,7 @@ GetSrcInfoForPc( * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index - * of the command containing the pc should + * of the command containing the pc should * be stored. */ { register int pcOffset = (pc - codePtr->codeStart); diff --git a/generic/tclIO.c b/generic/tclIO.c index b97f57a..8b2e149 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -578,11 +578,11 @@ TclFinalizeIOSubsystem(void) int active = 1; /* Flag == 1 while there's still work to do */ int doflushnb; - /* Fetch the pre-TIP#398 compatibility flag */ + /* Fetch the pre-TIP#398 compatibility flag */ { const char *s; Tcl_DString ds; - + s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); doflushnb = ((s != NULL) && strcmp(s, "0")); if (s != NULL) { @@ -635,9 +635,9 @@ TclFinalizeIOSubsystem(void) /* Set the channel back into blocking mode to ensure that we wait * for all data to flush out. */ - + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); + "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || @@ -1022,8 +1022,7 @@ DeleteChannelTable( Tcl_DeleteHashEntry(hPtr); SetFlag(statePtr, CHANNEL_TAINTED); - statePtr->refCount--; - if (statePtr->refCount <= 0) { + if (statePtr->refCount-- <= 1) { if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { (void) Tcl_Close(interp, (Tcl_Channel) chanPtr); } @@ -2657,7 +2656,7 @@ FlushChannel( * the post-condition that on a successful return to caller we've * left space in the current output buffer for more writing (the flush * call was to make new room). - * If the channel is blocking, then yes, so we guarantee that + * If the channel is blocking, then yes, so we guarantee that * blocking flushes actually flush all pending data. * Otherwise, no. Keep the current output buffer where it is so more * can be written to it, possibly filling it, to promote more efficient @@ -2844,7 +2843,7 @@ FlushChannel( /* * When we are calledFromAsyncFlush, that means a writable * state on the channel triggered the call, so we should be - * able to write something. Either we did write something + * able to write something. Either we did write something * and wroteSome should be set, or there was nothing left to * write in this call, and we've completed the BG flush. * These are the two cases above. If we get here, that means @@ -4224,7 +4223,7 @@ Write( if (nextNewLine) { srcLimit = nextNewLine - src; } - + /* Get space to write into */ bufPtr = statePtr->curOutPtr; if (bufPtr == NULL) { @@ -4252,7 +4251,7 @@ Write( /* See chan-io-1.[89]. Tcl Bug 506297. */ statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; - + if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { /* We're reading from invalid/incomplete UTF-8 */ ReleaseChannelBuffer(bufPtr); @@ -4292,7 +4291,7 @@ Write( Tcl_Panic("unknown output translation requested"); break; } - + result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen, statePtr->outputEncodingFlags, &statePtr->outputEncodingState, dst, @@ -5711,7 +5710,7 @@ DoReadChars( int factor = UTF_EXPANSION_FACTOR; binaryMode = (encoding == NULL) - && (statePtr->inputTranslation == TCL_TRANSLATE_LF) + && (statePtr->inputTranslation == TCL_TRANSLATE_LF) && (statePtr->inEofChar == '\0'); if (appendFlag == 0) { @@ -5981,7 +5980,7 @@ ReadChars( * expand when converted to UTF-8 chars. This guess comes from analyzing * how many characters were produced by the previous pass. */ - + int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; @@ -6014,7 +6013,7 @@ ReadChars( while (1) { int dstDecoded, dstRead, dstWrote, srcRead, numChars, code; int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE; - + if (charsToRead > 0) { flags |= TCL_ENCODING_CHAR_LIMIT; numChars = charsToRead; @@ -6149,7 +6148,7 @@ ReadChars( char buffer[TCL_UTF_MAX + 1]; int read, decoded, count; - /* + /* * Didn't get everything the buffer could offer */ @@ -6205,7 +6204,7 @@ ReadChars( /* FALL THROUGH - get more data (dstWrote == 0) */ } - /* + /* * The translation transformation can only reduce the number * of chars when it converts \r\n into \n. The reduction in * the number of chars is the difference in bytes read and written. @@ -6215,7 +6214,7 @@ ReadChars( if (charsToRead > 0 && numChars > charsToRead) { - /* + /* * TODO: This cannot happen anymore. * * We read more chars than allowed. Reset limits to @@ -6238,7 +6237,7 @@ ReadChars( assert (numChars == 0); - /* + /* * There is one situation where this is the correct final * result. If the src buffer contains only a single \n * byte, and we are in TCL_TRANSLATE_AUTO mode, and @@ -6331,7 +6330,7 @@ ReadChars( *--------------------------------------------------------------------------- */ -static void +static void TranslateInputEOL( ChannelState *statePtr, /* Channel being read, for EOL translation and * EOF character. */ @@ -6537,7 +6536,7 @@ Tcl_Ungets( /* * Clear the EOF flags, and clear the BLOCKED bit. */ - + if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } @@ -6694,7 +6693,7 @@ GetInput( ChannelState *statePtr = chanPtr->state; /* State info for channel */ - /* + /* * Verify that all callers know better than to call us when * it's recorded that the next char waiting to be read is the * eofchar. @@ -9206,7 +9205,7 @@ MBEvent( } } -static int +static int MBRead( CopyState *csPtr) { @@ -9227,7 +9226,7 @@ MBRead( } } -static int +static int MBWrite( CopyState *csPtr) { @@ -9654,7 +9653,7 @@ CopyData( * DoRead -- * * Stores up to "bytesToRead" bytes in memory pointed to by "dst". - * These bytes come from reading the channel "chanPtr" and + * These bytes come from reading the channel "chanPtr" and * performing the configured translations. No encoding conversions * are applied to the bytes being read. * @@ -9724,7 +9723,7 @@ DoRead( TclChannelPreserve((Tcl_Channel)chanPtr); while (bytesToRead) { /* - * Each pass through the loop is intended to process up to + * Each pass through the loop is intended to process up to * one channel buffer. */ @@ -9732,13 +9731,13 @@ DoRead( ChannelBuffer *bufPtr = statePtr->inQueueHead; /* - * Don't read more data if we have what we need. + * Don't read more data if we have what we need. */ while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ (BytesLeft(bufPtr) < bytesToRead) ) ) { - /* Not enough bytes in it + /* Not enough bytes in it * yet to fill the dst */ int code; diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 58d1a22..7f61def 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -683,7 +683,7 @@ TransformInputProc( * Already saw EOF from downChan; don't ask again. * NOTE: Could move this up to avoid the last maxRead * execution. Believe this would still be correct behavior, - * but the test suite tests the whole command callback + * but the test suite tests the whole command callback * sequence, so leave it unchanged for now. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 2537ad8..356d250 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4039,7 +4039,7 @@ typedef const char *TclDTraceStr; */ # define TclDecrRefCount(objPtr) \ - if (--(objPtr)->refCount > 0) ; else { \ + if ((objPtr)->refCount-- > 1) ; else { \ if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ @@ -4679,7 +4679,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #define TclCleanupCommandMacro(cmdPtr) \ - if (--(cmdPtr)->refCount <= 0) { \ + if ((cmdPtr)->refCount-- <= 1) { \ ckfree((char *) (cmdPtr));\ } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index bd2dbc4..fa67ee6 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -137,7 +137,7 @@ NewListIntRep( * Creates a list internal rep with space for objc elements. objc * must be > 0. If objv!=NULL, initializes with the first objc values * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. + * 0 elements, with space to add objc more. * * Results: * A new List struct with refCount 0 is returned. If some failure @@ -1726,7 +1726,7 @@ FreeListInternalRep( { List *listRepPtr = ListRepPtr(listPtr); - if (--listRepPtr->refCount <= 0) { + if (listRepPtr->refCount-- <= 1) { Tcl_Obj **elemPtrs = &listRepPtr->elements; int i, numElems = listRepPtr->elemCount; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 8f2f10e..91239f0 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -343,7 +343,7 @@ Tcl_PushCallFrame( framePtr->clientData = NULL; framePtr->localCachePtr = NULL; framePtr->tailcallPtr = NULL; - + /* * Push the new call frame onto the interpreter's stack of procedure call * frames making it the current frame. @@ -3056,7 +3056,7 @@ NamespaceCodeCmd( */ arg = TclGetStringFromObj(objv[1], &length); - if (*arg==':' && length > 20 + if (*arg==':' && length > 20 && strncmp(arg, "::namespace inscope ", 20) == 0) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; @@ -4929,7 +4929,7 @@ TclLogCommandInfo( if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; - + newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); @@ -4961,7 +4961,7 @@ TclLogCommandInfo( Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(command, length)); } - } + } if (!iPtr->framePtr->objc) { /* @@ -5014,7 +5014,7 @@ TclErrorStackResetIf( if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; - + newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); @@ -5034,7 +5034,7 @@ TclErrorStackResetIf( Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(msg, length)); - } + } } /* diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 2a81091..facf90d 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -156,7 +156,7 @@ void TclOODeleteChain( CallChain *callPtr) { - if (callPtr == NULL || --callPtr->refCount >= 1) { + if (callPtr == NULL || callPtr->refCount-- > 1) { return; } if (callPtr->chain != callPtr->staticChain) { diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index c0e4022..208e32c 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -588,7 +588,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #define AddRef(ptr) ((ptr)->refCount++) #define DelRef(ptr) do { \ - if (--(ptr)->refCount < 1) { \ + if ((ptr)->refCount-- <= 1) { \ ckfree((char *) (ptr)); \ } \ } while(0) diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index f586e8c..e18eeec 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -272,7 +272,7 @@ void TclOODelMethodRef( Method *mPtr) { - if ((mPtr != NULL) && (--mPtr->refCount <= 0)) { + if ((mPtr != NULL) && (mPtr->refCount-- <= 1)) { if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) { mPtr->typePtr->deleteProc(mPtr->clientData); } @@ -720,7 +720,7 @@ InvokeProcedureMethod( Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); - if (--pmPtr->refCount < 1) { + if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); @@ -771,7 +771,7 @@ FinalizePMCall( * sensitive when it comes to performance! */ - if (--pmPtr->refCount < 1) { + if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); @@ -961,7 +961,7 @@ ProcedureMethodVarResolver( { int result; Tcl_ResolvedVarInfo *rPtr = NULL; - + result = ProcedureMethodCompiledVarResolver(interp, varName, strlen(varName), contextNs, &rPtr); @@ -1278,7 +1278,7 @@ DeleteProcedureMethod( { register ProcedureMethod *pmPtr = clientData; - if (--pmPtr->refCount < 1) { + if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } } @@ -1473,7 +1473,7 @@ FinalizeForwardCall( int result) { Tcl_Obj **argObjs = data[0]; - + TclStackFree(interp, argObjs); return result; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 15d874f..f9216b3 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4288,7 +4288,7 @@ FreeCmdNameInternalRep( * there are no more uses, free the ResolvedCmdName structure. */ - if (resPtr->refCount-- <= 1) { + if (resPtr->refCount-- == 1) { /* * Now free the cached command, unless it is still in its hash * table or if there are other references to it from other cmdName @@ -4404,7 +4404,7 @@ SetCmdNameFromAny( Command *oldCmdPtr = resPtr->cmdPtr; - if (oldCmdPtr->refCount-- <= 1) { + if (--oldCmdPtr->refCount == 0) { TclCleanupCommandMacro(oldCmdPtr); } } else { diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index 0bd8f93..cca13e8 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -459,8 +459,7 @@ TclHandleRelease( handlePtr, handlePtr->ptr2, handlePtr->ptr); } #endif - handlePtr->refCount--; - if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) { + if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) { ckfree(handlePtr); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index 2679bf1..7bf63c2 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2147,8 +2147,7 @@ TclProcDeleteProc( { Proc *procPtr = clientData; - procPtr->refCount--; - if (procPtr->refCount <= 0) { + if (procPtr->refCount-- <= 1) { TclProcCleanupProc(procPtr); } } @@ -2446,7 +2445,7 @@ FreeLambdaInternalRep( Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1; Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2; - if (procPtr->refCount-- <= 1) { + if (procPtr->refCount-- == 1) { TclProcCleanupProc(procPtr); } TclDecrRefCount(nsObjPtr); diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 5bc3aa2..ea25d4b 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -755,7 +755,7 @@ FreeRegexpInternalRep( * If this is the last reference to the regexp, free it. */ - if (--(regexpRepPtr->refCount) <= 0) { + if (regexpRepPtr->refCount-- <= 1) { FreeRegexp(regexpRepPtr); } objPtr->typePtr = NULL; @@ -976,7 +976,7 @@ CompileRegexp( if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) { TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1]; - if (--(oldRegexpPtr->refCount) <= 0) { + if (oldRegexpPtr->refCount-- <= 1) { FreeRegexp(oldRegexpPtr); } ckfree(tsdPtr->patterns[NUM_REGEXPS-1]); @@ -1050,7 +1050,7 @@ FinalizeRegexp( for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) { regexpPtr = tsdPtr->regexps[i]; - if (--(regexpPtr->refCount) <= 0) { + if (regexpPtr->refCount-- <= 1) { FreeRegexp(regexpPtr); } ckfree(tsdPtr->patterns[i]); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 66640ea..2c34866 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -1922,6 +1922,8 @@ RefineApproximation( rteSignificand = frexp(approxResult, &rteExponent); rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION); if ((rteSigWide & 1) == 0) { + mp_clear(&twoMd); + mp_clear(&twoMv); return approxResult; } } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 6184a89..fe52d59 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -544,7 +544,7 @@ TraceExecutionObjCmd( tcmdPtr->flags = 0; } - if ((--tcmdPtr->refCount) <= 0) { + if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } break; @@ -748,7 +748,7 @@ TraceCommandObjCmd( Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE, TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; - if ((--tcmdPtr->refCount) <= 0) { + if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } break; @@ -1130,7 +1130,7 @@ Tcl_TraceCommand( /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ - + if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){ Interp *iPtr = (Interp *) interp; iPtr->compileEpoch++; @@ -1138,7 +1138,7 @@ Tcl_TraceCommand( cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } - + return TCL_OK; } @@ -1223,7 +1223,7 @@ Tcl_UntraceCommand( } tracePtr->flags = 0; - if ((--tracePtr->refCount) <= 0) { + if (tracePtr->refCount-- <= 1) { ckfree(tracePtr); } @@ -1245,7 +1245,7 @@ Tcl_UntraceCommand( /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ - + if (cmdPtr->compileProc != NULL) { Interp *iPtr = (Interp *) interp; iPtr->compileEpoch++; @@ -1382,7 +1382,7 @@ TraceCommandProc( Tcl_RestoreInterpState(interp, state); tcmdPtr->refCount--; } - if ((--tcmdPtr->refCount) <= 0) { + if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } @@ -1474,7 +1474,7 @@ TclCheckExecutionTraces( } traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); - if ((--tcmdPtr->refCount) <= 0) { + if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } @@ -1721,7 +1721,7 @@ CommandObjTraceDeleted( { TraceCommandInfo *tcmdPtr = clientData; - if ((--tcmdPtr->refCount) <= 0) { + if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } @@ -1936,7 +1936,7 @@ TraceExecutionProc( } } if (call) { - if ((--tcmdPtr->refCount) <= 0) { + if (tcmdPtr->refCount-- <= 1) { ckfree(tcmdPtr); } } diff --git a/generic/tclVar.c b/generic/tclVar.c index 97aa7ab..e897790 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -235,25 +235,6 @@ static const Tcl_ObjType localVarNameType = { FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName }; -/* - * Caching of namespace variables disabled: no simple way was found to avoid - * interfering with the resolver's idea of variable existence. A cached - * varName may keep a variable's name in the namespace's hash table, which is - * the resolver's criterion for existence (see test namespace-17.10). - */ - -#define ENABLE_NS_VARNAME_CACHING 0 - -#if ENABLE_NS_VARNAME_CACHING -static Tcl_FreeInternalRepProc FreeNsVarName; -static Tcl_DupInternalRepProc DupNsVarName; - -static const Tcl_ObjType tclNsVarNameType = { - "namespaceVarName", - FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName -}; -#endif - static const Tcl_ObjType tclParsedVarNameType = { "parsedVarName", FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName @@ -554,27 +535,10 @@ TclObjLookupVarEx( const Tcl_ObjType *typePtr = part1Ptr->typePtr; const char *errMsg = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; -#if ENABLE_NS_VARNAME_CACHING - Namespace *nsPtr; -#endif const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL; char *newPart2 = NULL; - *arrayPtrPtr = NULL; -#if ENABLE_NS_VARNAME_CACHING - if (varFramePtr) { - nsPtr = varFramePtr->nsPtr; - } else { - /* - * Some variables in the global ns have to be initialized before the - * root call frame is in place. - */ - - nsPtr = NULL; - } -#endif - if (typePtr == &localVarNameType) { int localIndex; @@ -597,44 +561,6 @@ TclObjLookupVarEx( } } goto doneParsing; -#if ENABLE_NS_VARNAME_CACHING - } else if (typePtr == &tclNsVarNameType) { - int useGlobal, useReference; - Namespace *cachedNsPtr = part1Ptr->internalRep.twoPtrValue.ptr1; - varPtr = part1Ptr->internalRep.twoPtrValue.ptr2; - - useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && ( - (flags & TCL_GLOBAL_ONLY) || - (part1[0]==':' && part1[1]==':') || - (!HasLocalVars(varFramePtr) && (nsPtr==iPtr->globalNsPtr))); - - useReference = useGlobal || ((cachedNsPtr == nsPtr) && ( - (flags & TCL_NAMESPACE_ONLY) || - (!HasLocalVars(varFramePtr) && !(flags & TCL_GLOBAL_ONLY) && - /* - * Careful: an undefined ns variable could be hiding a valid - * global reference. - */ - !TclIsVarUndefined(varPtr)))); - - if (useReference && !TclIsVarDeadHash(varPtr)) { - /* - * A straight global or namespace reference, use it. It isn't so - * simple to deal with 'implicit' namespace references, i.e., - * those where the reference could be to either a namespace or a - * global variable. Those we lookup again. - * - * If TclIsVarDeadHash(varPtr), this might be a reference to a - * variable in a deleted namespace, kept alive by e.g. part1Ptr. - * We could conceivably be so unlucky that a new namespace was - * created at the same address as the deleted one, so to be safe - * we test for a valid hPtr. - */ - - goto donePart1; - } - goto doneParsing; -#endif } /* @@ -782,20 +708,6 @@ TclObjLookupVarEx( part1Ptr->internalRep.twoPtrValue.ptr1 = NULL; } part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index); -#if ENABLE_NS_VARNAME_CACHING - } else if (index > -3) { - /* - * A cacheable namespace or global variable. - */ - - Namespace *nsPtr; - - nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr); - varPtr->refCount++; - part1Ptr->typePtr = &tclNsVarNameType; - part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr; - part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr; -#endif } else { /* * At least mark part1Ptr as already parsed. @@ -807,18 +719,6 @@ TclObjLookupVarEx( } donePart1: -#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */ - if (varPtr == NULL) { - if (flags & TCL_LEAVE_ERR_MSG) { - part1 = TclGetString(part1Ptr); - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, - "cached variable reference is NULL.", -1); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", - TclGetString(part1Ptr), NULL); - } - return NULL; - } -#endif while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } @@ -1912,17 +1812,6 @@ TclPtrSetVar( varPtr->value.objPtr = NULL; } if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) { -#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */ - /* - * Can't happen now! - */ - - if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { - TclDecrRefCount(oldValuePtr); /* Discard old value. */ - varPtr->value.objPtr = NULL; - oldValuePtr = NULL; - } -#endif if (flags & TCL_LIST_ELEMENT) { /* Append list element. */ if (oldValuePtr == NULL) { TclNewObj(oldValuePtr); @@ -2388,18 +2277,6 @@ TclPtrUnsetVar( } } -#if ENABLE_NS_VARNAME_CACHING - /* - * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType - * keeping a reference. This removes some additional exteriorisations of - * [Bug 736729], but may be a good thing independently of the bug. - */ - - if (part1Ptr->typePtr == &tclNsVarNameType) { - TclFreeIntRep(part1Ptr); - } -#endif - /* * Finally, if the variable is truly not in use then free up its Var * structure and remove it from its hash table, if any. The ref count of @@ -5698,46 +5575,6 @@ DupLocalVarName( dupPtr->typePtr = &localVarNameType; } -#if ENABLE_NS_VARNAME_CACHING -/* - * nsVarName - - * - * INTERNALREP DEFINITION: - * twoPtrValue.ptr1: pointer to the namespace containing the reference. - * twoPtrValue.ptr2: pointer to the corresponding Var - */ - -static void -FreeNsVarName( - Tcl_Obj *objPtr) -{ - register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2; - - if (TclIsVarInHash(varPtr) && TclIsVarUndefined(varPtr)) { - if ((varPtr->refCount-- <= 1)) { - CleanupVar(varPtr, NULL); - } - } - objPtr->typePtr = NULL; -} - -static void -DupNsVarName( - Tcl_Obj *srcPtr, - Tcl_Obj *dupPtr) -{ - Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1; - register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2; - - dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr; - dupPtr->internalRep.twoPtrValue.ptr2 = varPtr; - if (TclIsVarInHash(varPtr)) { - varPtr->refCount++; - } - dupPtr->typePtr = &tclNsVarNameType; -} -#endif - /* * parsedVarName - * diff --git a/tests/execute.test b/tests/execute.test index aaf4bc0..9a2ffbd 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1057,6 +1057,15 @@ test execute-11.2 {Bug 268b23df11} -setup { rename crash {} rename zero {} } -result 0 +test execute-11.3 {Bug a0ece9d6d4} -setup { + proc crash {} {expr {rand()}} + trace add execution crash enterstep {apply {args {info frame -2}}} +} -body { + string is double [crash] +} -cleanup { + trace remove execution crash enterstep {apply {args {info frame -2}}} + rename crash {} +} -result 1 # cleanup if {[info commands testobj] != {}} { |