summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog17
-rw-r--r--doc/global.n5
-rw-r--r--doc/info.n6
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclCmdIL.c5
-rw-r--r--generic/tclCompCmds.c175
-rw-r--r--generic/tclInt.h8
-rw-r--r--tests/info.test4
8 files changed, 211 insertions, 17 deletions
diff --git a/ChangeLog b/ChangeLog
index eaa3333..ca8212a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,19 @@
-2002-06-10 Miguel Sofer <msofer@users.sourceforge.net>
+2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * doc/global.n:
+ * doc/info.n:
+ * test/info.test:
+ * generic/tclCmdIL.c: fix for [Bug 567386], [info locals] was
+ reporting some linked variables.
+
+ * generic/tclBasic.c:
+ * generic/tclCompCmds.c:
+ * generic/tclInt.h: added compile functions for [global],
+ [variable] and [upvar]. They just declare the new local variables,
+ the commands themselves are not compiled-in. This gives a notably
+ faster read access to these linked variables.
+
+2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
* generic/tclExecute.c: optimised algorithm for exception range
lookup; part of [Patch 453709].
diff --git a/doc/global.n b/doc/global.n
index 2b8787a..d4fd4c0 100644
--- a/doc/global.n
+++ b/doc/global.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: global.n,v 1.3 2000/11/21 15:56:21 dkf Exp $
+'\" RCS: @(#) $Id: global.n,v 1.4 2002/06/11 13:22:35 msofer Exp $
'\"
.so man.macros
.TH global n "" Tcl "Tcl Built-In Commands"
@@ -28,9 +28,6 @@ For the duration of the current procedure
any reference to any of the \fIvarname\fRs
will refer to the global variable by the same name.
.PP
-Please note that this is done by creating local variables that are
-linked to the global variables, and therefore that these variables
-will be listed by \fBinfo locals\fR like all other local variables.
.SH "SEE ALSO"
namespace(n), upvar(n), variable(n)
diff --git a/doc/info.n b/doc/info.n
index 3ddd9e9..ab78347 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -7,7 +7,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: info.n,v 1.7 2001/05/30 08:57:06 dkf Exp $
+'\" RCS: @(#) $Id: info.n,v 1.8 2002/06/11 13:22:35 msofer Exp $
'\"
.so man.macros
.TH info n 8.4 Tcl "Tcl Built-In Commands"
@@ -140,8 +140,8 @@ an empty string for the \fIinterp\fR argument.
If \fIpattern\fR isn't specified, returns a list of all the names
of currently-defined local variables, including arguments to the
current procedure, if any.
-Variables defined with the \fBglobal\fR and \fBupvar\fR commands
-will not be returned.
+Variables defined with the \fBglobal\fR, \fBupvar\fR and
+\fBvariable\fR commands will not be returned.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
are returned. Matching is determined using the same rules as for
\fBstring match\fR.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index bb72114..7be14aa 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.56 2002/03/29 21:01:11 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.57 2002/06/11 13:22:35 msofer Exp $
*/
#include "tclInt.h"
@@ -109,7 +109,7 @@ static CmdInfo builtInCmds[] = {
{"format", (Tcl_CmdProc *) NULL, Tcl_FormatObjCmd,
(CompileProc *) NULL, 1},
{"global", (Tcl_CmdProc *) NULL, Tcl_GlobalObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileGlobalCmd, 1},
{"if", (Tcl_CmdProc *) NULL, Tcl_IfObjCmd,
TclCompileIfCmd, 1},
{"incr", (Tcl_CmdProc *) NULL, Tcl_IncrObjCmd,
@@ -173,9 +173,9 @@ static CmdInfo builtInCmds[] = {
{"uplevel", (Tcl_CmdProc *) NULL, Tcl_UplevelObjCmd,
(CompileProc *) NULL, 1},
{"upvar", (Tcl_CmdProc *) NULL, Tcl_UpvarObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileUpvarCmd, 1},
{"variable", (Tcl_CmdProc *) NULL, Tcl_VariableObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileVariableCmd, 1},
{"while", (Tcl_CmdProc *) NULL, Tcl_WhileObjCmd,
TclCompileWhileCmd, 1},
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 3e1f0da..36b1ef5 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.43 2002/04/18 14:12:07 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.44 2002/06/11 13:22:36 msofer Exp $
*/
#include "tclInt.h"
@@ -1387,7 +1387,8 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
* Skip nameless (temporary) variables and undefined variables
*/
- if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)) {
+ if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
+ && (includeLinks || !TclIsVarLink(varPtr))) {
varName = varPtr->name;
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fefc33a..a9b04a2 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.28 2002/05/29 09:09:12 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.29 2002/06/11 13:22:36 msofer Exp $
*/
#include "tclInt.h"
@@ -1117,6 +1117,59 @@ FreeForeachInfo(clientData)
/*
*----------------------------------------------------------------------
*
+ * TclCompileGlobalCmd --
+ *
+ * Procedure called to reserve the local variables for the
+ * "global" command. The command itself is *not* compiled.
+ *
+ * Results:
+ * Always returns TCL_OUT_LINE_COMPILE.
+ *
+ * Side effects:
+ * Indexed local variables are added to the environment.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclCompileGlobalCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *varTokenPtr;
+ int i, numWords;
+ char *varName, *tail;
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+ numWords = parsePtr->numWords;
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ for (i = 1; i < numWords; i++) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ varName = varTokenPtr[1].start;
+ tail = varName + varTokenPtr[1].size - 1;
+ if ((*tail == ')') || (tail < varName)) continue;
+ while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+ tail--;
+ }
+ if ((*tail == ':') && (tail > varName)) {
+ tail++;
+ }
+ (void) TclFindCompiledLocal(tail, (tail-varName+1),
+ /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+ }
+ return TCL_OUT_LINE_COMPILE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileIfCmd --
*
* Procedure called to compile the "if" command.
@@ -2845,6 +2898,126 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
/*
*----------------------------------------------------------------------
*
+ * TclCompileUpvarCmd --
+ *
+ * Procedure called to reserve the local variables for the
+ * "upvar" command. The command itself is *not* compiled.
+ *
+ * Results:
+ * Always returns TCL_OUT_LINE_COMPILE.
+ *
+ * Side effects:
+ * Indexed local variables are added to the environment.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclCompileUpvarCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *varTokenPtr;
+ int i, numWords;
+ char *varName, *tail;
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ numWords = parsePtr->numWords;
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ varName = varTokenPtr[1].start;
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ i = 2;
+
+ if ((*varName == '#') || (isdigit(UCHAR(*varName)))) {
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ i++;
+ }
+
+ for (; i < numWords; i += 2) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ varName = varTokenPtr[1].start;
+ tail = varName + varTokenPtr[1].size - 1;
+ if ((*tail == ')') || (tail < varName)) {
+ break;
+ }
+ while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+ tail--;
+ }
+ if (tail != varName) {
+ break;
+ }
+ (void) TclFindCompiledLocal(tail, (tail-varName+1),
+ /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+ }
+ return TCL_OUT_LINE_COMPILE;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileVariableCmd --
+ *
+ * Procedure called to reserve the local variables for the
+ * "variable" command. The command itself is *not* compiled.
+ *
+ * Results:
+ * Always returns TCL_OUT_LINE_COMPILE.
+ *
+ * Side effects:
+ * Indexed local variables are added to the environment.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclCompileVariableCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *varTokenPtr;
+ int i, numWords;
+ char *varName, *tail;
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ numWords = parsePtr->numWords;
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ for (i = 1; i < numWords; i += 2) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ varName = varTokenPtr[1].start;
+ tail = varName + varTokenPtr[1].size - 1;
+ if ((*tail == ')') || (tail < varName)) continue;
+ while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+ tail--;
+ }
+ if ((*tail == ':') && (tail > varName)) {
+ tail++;
+ }
+ (void) TclFindCompiledLocal(tail, (tail-varName+1),
+ /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+ }
+ return TCL_OUT_LINE_COMPILE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileWhileCmd --
*
* Procedure called to compile the "while" command.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9cea9d7..a6d5259 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.91 2002/05/31 22:20:20 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.92 2002/06/11 13:22:36 msofer Exp $
*/
#ifndef _TCLINT
@@ -2127,6 +2127,8 @@ EXTERN int TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileGlobalCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
@@ -2149,6 +2151,10 @@ EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileStringCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileUpvarCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileVariableCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
diff --git a/tests/info.test b/tests/info.test
index 801df6f..686aa35 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: info.test,v 1.20 2002/04/18 18:05:59 msofer Exp $
+# RCS: @(#) $Id: info.test,v 1.21 2002/06/11 13:22:36 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -371,6 +371,8 @@ test info-12.1 {info locals option} {
set b 13
set c testing
global a
+ global aa
+ set aa 23
return [info locals]
}
lsort [t1 23 24]
generated by cgit v0.12 at 2024-11-17 23:47:05 (GMT)