summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-04-10 08:13:40 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-04-10 08:13:40 (GMT)
commit656f3951340642cf7d3ce37e1e9b1aa7141784e9 (patch)
treecc5369ca591b2a5961da9383f070b4a1a185ed18 /generic
parent67d714cab480480fb736bb1a1c6fa30f9b2d845c (diff)
parentba795792d6185008b4de5f9c0463f26fa2ddab0a (diff)
downloadtcl-656f3951340642cf7d3ce37e1e9b1aa7141784e9.zip
tcl-656f3951340642cf7d3ce37e1e9b1aa7141784e9.tar.gz
tcl-656f3951340642cf7d3ce37e1e9b1aa7141784e9.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tclEnv.c15
-rw-r--r--generic/tclOO.c1
-rw-r--r--generic/tclOODefineCmds.c52
-rw-r--r--generic/tclPort.h7
-rw-r--r--generic/tclVar.c52
6 files changed, 104 insertions, 27 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index c6cbe96..afeae51 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -774,10 +774,10 @@ declare 216 {
declare 217 {
void Tcl_ResetResult(Tcl_Interp *interp)
}
-declare 218 generic {
+declare 218 {
int Tcl_ScanElement(const char *src, int *flagPtr)
}
-declare 219 generic {
+declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 980a785..72d6fba 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -45,11 +45,8 @@ MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
#if defined(__CYGWIN__)
-/* On Cygwin, the environment is imported from the Cygwin DLL. */
- DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
- DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
-# define putenv TclCygwinPutenv
-static void TclCygwinPutenv(char *string);
+ static void TclCygwinPutenv(char *string);
+# define putenv TclCygwinPutenv
#endif
/*
@@ -754,15 +751,11 @@ TclCygwinPutenv(
*/
if (strcmp(name, "Path") == 0) {
-#ifdef __WIN32__
SetEnvironmentVariableA("PATH", NULL);
-#endif
unsetenv("PATH");
}
-#ifdef __WIN32__
SetEnvironmentVariableA(name, value);
-#endif
} else {
char *buf;
@@ -770,9 +763,7 @@ TclCygwinPutenv(
* Eliminate any Path variable, to prevent any confusion.
*/
-#ifdef __WIN32__
SetEnvironmentVariableA("Path", NULL);
-#endif
unsetenv("Path");
if (value == NULL) {
@@ -785,9 +776,7 @@ TclCygwinPutenv(
cygwin_posix_to_win32_path_list(value, buf);
}
-#ifdef __WIN32__
SetEnvironmentVariableA(name, buf);
-#endif
}
}
#endif /* __CYGWIN__ */
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 1d1276d..d5cc6e1 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1780,7 +1780,6 @@ FinalizeAlloc(
Object *oPtr = data[1];
Tcl_InterpState state = data[2];
Tcl_Object *objectPtr = data[3];
- //int flags = oPtr->flags;
/*
* It's an error if the object was whacked in the constructor. Force this
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 926966b..3d72690 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2306,11 +2306,32 @@ ClassVarsSet(
ckalloc(sizeof(Tcl_Obj *) * varc);
}
}
+
+ oPtr->classPtr->variables.num = 0;
if (varc > 0) {
- memcpy(oPtr->classPtr->variables.list, varv,
- sizeof(Tcl_Obj *) * varc);
+ int created, n;
+ Tcl_HashTable uniqueTable;
+
+ Tcl_InitObjHashTable(&uniqueTable);
+ for (i=n=0 ; i<varc ; i++) {
+ Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+ if (created) {
+ oPtr->classPtr->variables.list[n++] = varv[i];
+ } else {
+ Tcl_DecrRefCount(varv[i]);
+ }
+ }
+ oPtr->classPtr->variables.num = n;
+
+ /*
+ * Shouldn't be necessary, but maintain num/list invariant.
+ */
+
+ oPtr->classPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->classPtr->variables.list,
+ sizeof(Tcl_Obj *) * n);
+ Tcl_DeleteHashTable(&uniqueTable);
}
- oPtr->classPtr->variables.num = varc;
return TCL_OK;
}
@@ -2563,10 +2584,31 @@ ObjVarsSet(
ckalloc(sizeof(Tcl_Obj *) * varc);
}
}
+ oPtr->variables.num = 0;
if (varc > 0) {
- memcpy(oPtr->variables.list, varv, sizeof(Tcl_Obj *)*varc);
+ int created, n;
+ Tcl_HashTable uniqueTable;
+
+ Tcl_InitObjHashTable(&uniqueTable);
+ for (i=n=0 ; i<varc ; i++) {
+ Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+ if (created) {
+ oPtr->variables.list[n++] = varv[i];
+ } else {
+ Tcl_DecrRefCount(varv[i]);
+ }
+ }
+ oPtr->variables.num = n;
+
+ /*
+ * Shouldn't be necessary, but maintain num/list invariant.
+ */
+
+ oPtr->variables.list = (Tcl_Obj **)
+ ckrealloc((char *) oPtr->variables.list,
+ sizeof(Tcl_Obj *) * n);
+ Tcl_DeleteHashTable(&uniqueTable);
}
- oPtr->variables.num = varc;
return TCL_OK;
}
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 23c6191..79bea88 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -29,10 +29,13 @@
# define USE_PUTENV 1
# define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
- DLLIMPORT extern char **__cygwin_environ;
- DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
# define environ __cygwin_environ
# define timezone _timezone
+ DLLIMPORT extern char **__cygwin_environ;
+ DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
+ DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
+ DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
+ DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
#endif
#if !defined(LLONG_MIN)
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 1bf4abc..e92dc5f 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -18,6 +18,7 @@
*/
#include "tclInt.h"
+#include "tclOOInt.h"
/*
* Prototypes for the variable hash key methods.
@@ -6083,7 +6084,7 @@ TclInfoVarsCmd(
}
}
}
- } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
+ } else if (iPtr->varFramePtr->procPtr != NULL) {
AppendLocals(interp, listPtr, simplePatternPtr, 1);
}
@@ -6269,17 +6270,21 @@ AppendLocals(
{
Interp *iPtr = (Interp *) interp;
Var *varPtr;
- int i, localVarCt;
+ int i, localVarCt, added;
Tcl_Obj **varNamePtr, *objNamePtr;
const char *varName;
TclVarHashTable *localVarTablePtr;
Tcl_HashSearch search;
+ Tcl_HashTable addedTable;
const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
localVarCt = iPtr->varFramePtr->numCompiledLocals;
varPtr = iPtr->varFramePtr->compiledLocals;
localVarTablePtr = iPtr->varFramePtr->varTablePtr;
varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
+ if (includeLinks) {
+ Tcl_InitObjHashTable(&addedTable);
+ }
for (i = 0; i < localVarCt; i++, varNamePtr++) {
/*
@@ -6291,6 +6296,9 @@ AppendLocals(
varName = TclGetString(*varNamePtr);
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
+ }
}
}
varPtr++;
@@ -6301,7 +6309,7 @@ AppendLocals(
*/
if (localVarTablePtr == NULL) {
- return;
+ goto objectVars;
}
/*
@@ -6315,9 +6323,13 @@ AppendLocals(
&& (includeLinks || !TclIsVarLink(varPtr))) {
Tcl_ListObjAppendElement(interp, listPtr,
VarHashGetKey(varPtr));
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
+ &added);
+ }
}
}
- return;
+ goto objectVars;
}
/*
@@ -6333,9 +6345,41 @@ AppendLocals(
varName = TclGetString(objNamePtr);
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+ if (includeLinks) {
+ Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
+ }
+ }
+ }
+ }
+
+ objectVars:
+ if (!includeLinks) {
+ return;
+ }
+
+ if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
+ CallContext *contextPtr = iPtr->varFramePtr->clientData;
+ Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+
+ if (mPtr->declaringObjectPtr) {
+ FOREACH(objNamePtr, mPtr->declaringObjectPtr->variables) {
+ Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
+ if (added && (!pattern ||
+ Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
+ Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+ }
+ }
+ } else {
+ FOREACH(objNamePtr, mPtr->declaringClassPtr->variables) {
+ Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
+ if (added && (!pattern ||
+ Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
+ Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
+ }
}
}
}
+ Tcl_DeleteHashTable(&addedTable);
}
/*