Skip to content

Commit e0ef154

Browse files
author
stanton
committed
* generic/tclProc.c:
* generic/tclNamesp.c: * generic/tclInt.h: * generic/tclCmdIL.c: * generic/tclBasic.c: * generic/tclVar.c: Applied patch from Viktor Dukhovni to rationalize TCL_LEAVE_ERR_MSG behavior when creating variables. * generic/tclVar.c: Fixed bug in namespace tail computation. Fixed bug where upvar could resurrect a namespace variable whose namespace had been deleted. * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another bogus optimization in expression compilation. * generic/tclCompile.c (CompileExprWord): Fixed exception stack overflow bug caused by missing statement. [Bug: 928] * generic/tclIOCmd.c: * generic/tclBasic.c: Objectified the "open" command. [Bug: 1113]
1 parent d302d0e commit e0ef154

File tree

9 files changed

+407
-331
lines changed

9 files changed

+407
-331
lines changed

‎generic/tclBasic.c

Lines changed: 13 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,12 @@
77
*
88
* Copyright (c) 1987-1994 The Regents of the University of California.
99
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
10-
* Copyright (c) 1998 by Scriptics Corporation.
10+
* Copyright (c) 1998-1999 by Scriptics Corporation.
1111
*
1212
* See the file "license.terms" for information on usage and redistribution
1313
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1414
*
15-
* RCS: @(#) $Id: tclBasic.c,v 1.14 1999/02/02 22:25:42 stanton Exp $
15+
* RCS: @(#) $Id: tclBasic.c,v 1.15 1999/02/03 00:55:04 stanton Exp $
1616
*/
1717

1818
#include "tclInt.h"
@@ -1421,7 +1421,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
14211421
Command *cmdPtr, *refCmdPtr;
14221422
Tcl_HashEntry *hPtr;
14231423
char *tail;
1424-
int new, result;
1424+
int new;
14251425
ImportedCmdData *dataPtr;
14261426

14271427
if (iPtr->flags & DELETED) {
@@ -1440,10 +1440,9 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
14401440
*/
14411441

14421442
if (strstr(cmdName, "::") != NULL) {
1443-
result = TclGetNamespaceForQualName(interp, cmdName,
1444-
(Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr,
1445-
&dummy1, &dummy2, &tail);
1446-
if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
1443+
TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
1444+
CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
1445+
if ((nsPtr == NULL) || (tail == NULL)) {
14471446
return (Tcl_Command) NULL;
14481447
}
14491448
} else {
@@ -1568,7 +1567,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
15681567
Command *cmdPtr, *refCmdPtr;
15691568
Tcl_HashEntry *hPtr;
15701569
char *tail;
1571-
int new, result;
1570+
int new;
15721571
ImportedCmdData *dataPtr;
15731572

15741573
if (iPtr->flags & DELETED) {
@@ -1587,10 +1586,9 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
15871586
*/
15881587

15891588
if (strstr(cmdName, "::") != NULL) {
1590-
result = TclGetNamespaceForQualName(interp, cmdName,
1591-
(Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr,
1592-
&dummy1, &dummy2, &tail);
1593-
if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
1589+
TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
1590+
CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
1591+
if ((nsPtr == NULL) || (tail == NULL)) {
15941592
return (Tcl_Command) NULL;
15951593
}
15961594
} else {
@@ -1921,12 +1919,9 @@ TclRenameCommand(interp, oldName, newName)
19211919
* Tcl_CreateCommand would.
19221920
*/
19231921

1924-
result = TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
1925-
(CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
1926-
&newNsPtr, &dummy1, &dummy2, &newTail);
1927-
if (result != TCL_OK) {
1928-
return result;
1929-
}
1922+
TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
1923+
CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
1924+
19301925
if ((newNsPtr == NULL) || (newTail == NULL)) {
19311926
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
19321927
"can't rename to \"", newName, "\": bad command name",

‎generic/tclCmdIL.c

Lines changed: 8 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -9,12 +9,12 @@
99
* Copyright (c) 1987-1993 The Regents of the University of California.
1010
* Copyright (c) 1993-1997 Lucent Technologies.
1111
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
12-
* Copyright (c) 1998 by Scriptics Corporation.
12+
* Copyright (c) 1998-1999 by Scriptics Corporation.
1313
*
1414
* See the file "license.terms" for information on usage and redistribution
1515
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1616
*
17-
* RCS: @(#) $Id: tclCmdIL.c,v 1.10 1998/10/13 20:30:22 rjohnson Exp $
17+
* RCS: @(#) $Id: tclCmdIL.c,v 1.11 1999/02/03 00:55:04 stanton Exp $
1818
*/
1919

2020
#include "tclInt.h"
@@ -643,7 +643,6 @@ InfoCommandsCmd(dummy, interp, objc, objv)
643643
Tcl_Obj *listPtr, *elemObjPtr;
644644
int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
645645
Tcl_Command cmd;
646-
int result;
647646

648647
/*
649648
* Get the pattern and find the "effective namespace" in which to
@@ -666,12 +665,9 @@ InfoCommandsCmd(dummy, interp, objc, objv)
666665
Namespace *dummy1NsPtr, *dummy2NsPtr;
667666

668667
pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
669-
result = TclGetNamespaceForQualName(interp, pattern,
670-
(Namespace *) NULL, /*flags*/ TCL_LEAVE_ERR_MSG,
671-
&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
672-
if (result != TCL_OK) {
673-
return TCL_ERROR;
674-
}
668+
TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
669+
/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
670+
675671
if (nsPtr != NULL) { /* we successfully found the pattern's ns */
676672
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
677673
}
@@ -1628,7 +1624,6 @@ InfoVarsCmd(dummy, interp, objc, objv)
16281624
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
16291625
Tcl_Obj *listPtr, *elemObjPtr;
16301626
int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
1631-
int result;
16321627

16331628
/*
16341629
* Get the pattern and find the "effective namespace" in which to
@@ -1652,12 +1647,9 @@ InfoVarsCmd(dummy, interp, objc, objv)
16521647
Namespace *dummy1NsPtr, *dummy2NsPtr;
16531648

16541649
pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
1655-
result = TclGetNamespaceForQualName(interp, pattern,
1656-
(Namespace *) NULL, /*flags*/ TCL_LEAVE_ERR_MSG,
1657-
&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
1658-
if (result != TCL_OK) {
1659-
return TCL_ERROR;
1660-
}
1650+
TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
1651+
/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
1652+
16611653
if (nsPtr != NULL) { /* we successfully found the pattern's ns */
16621654
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
16631655
}

‎generic/tclCompile.c

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@
1111
* See the file "license.terms" for information on usage and redistribution
1212
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1313
*
14-
* RCS: @(#) $Id: tclCompile.c,v 1.12 1999/02/02 22:26:11 stanton Exp $
14+
* RCS: @(#) $Id: tclCompile.c,v 1.13 1999/02/03 00:55:04 stanton Exp $
1515
*/
1616

1717
#include "tclInt.h"
@@ -3879,7 +3879,7 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
38793879

38803880
/*
38813881
* Scan the concatenated expression's characters looking for any
3882-
* '['s or (for now) '\'s. If any are found, just call the expr cmd
3882+
* '['s or '\'s or '$'s. If any are found, just call the expr cmd
38833883
* at runtime.
38843884
*/
38853885

@@ -3888,7 +3888,7 @@ TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
38883888
last = first + (Tcl_DStringLength(&buffer) - 1);
38893889
for (p = first; p <= last; p++) {
38903890
c = *p;
3891-
if ((c == '[') || (c == '\\')) {
3891+
if ((c == '[') || (c == '\\') || (c == '$')) {
38923892
inlineCode = 0;
38933893
break;
38943894
}

‎generic/tclInt.h

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,12 +6,12 @@
66
* Copyright (c) 1987-1993 The Regents of the University of California.
77
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
88
* Copyright (c) 1993-1997 Lucent Technologies.
9-
* Copyright (c) 1998 by Scriptics Corporation.
9+
* Copyright (c) 1998-1999 by Scriptics Corporation.
1010
*
1111
* See the file "license.terms" for information on usage and redistribution
1212
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1313
*
14-
* RCS: @(#) $Id: tclInt.h,v 1.21 1999/02/02 22:27:02 stanton Exp $
14+
* RCS: @(#) $Id: tclInt.h,v 1.22 1999/02/03 00:55:05 stanton Exp $
1515
*/
1616

1717
#ifndef _TCLINT
@@ -1502,7 +1502,7 @@ EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
15021502
char *string, long *longPtr));
15031503
EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
15041504
Tcl_Interp *interp, char *targetName));
1505-
EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
1505+
EXTERN void TclGetNamespaceForQualName _ANSI_ARGS_((
15061506
Tcl_Interp *interp, char *qualName,
15071507
Namespace *cxtNsPtr, int flags,
15081508
Namespace **nsPtrPtr, Namespace **altNsPtrPtr,

0 commit comments

Comments
 (0)