From 32dda4af9bc7d9e23f8dc6722d26609e4714a470 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 5 Apr 2012 07:07:10 +0000 Subject: cygwin should use SetEnvironmentVariable for windows env --- generic/tclEnv.c | 23 ++++++----------------- generic/tclPort.h | 7 +++++-- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/generic/tclEnv.c b/generic/tclEnv.c index a516cce..24fa106 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 /* @@ -753,15 +750,11 @@ TclCygwinPutenv( */ if (strcmp(name, "Path") == 0) { -#ifdef __WIN32__ - SetEnvironmentVariable("PATH", NULL); -#endif + SetEnvironmentVariableA("PATH", NULL); unsetenv("PATH"); } -#ifdef __WIN32__ - SetEnvironmentVariable(name, value); -#endif + SetEnvironmentVariableA(name, value); } else { char *buf; @@ -769,9 +762,7 @@ TclCygwinPutenv( * Eliminate any Path variable, to prevent any confusion. */ -#ifdef __WIN32__ - SetEnvironmentVariable("Path", NULL); -#endif + SetEnvironmentVariableA("Path", NULL); unsetenv("Path"); if (value == NULL) { @@ -784,9 +775,7 @@ TclCygwinPutenv( cygwin_posix_to_win32_path_list(value, buf); } -#ifdef __WIN32__ - SetEnvironmentVariable(name, buf); -#endif + SetEnvironmentVariableA(name, buf); } } #endif /* __CYGWIN__ */ 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) -- cgit v0.12 From 4d8a945fc474dc4d42a6c0903f3eb2e0b62bd9a4 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 9 Apr 2012 17:04:21 +0000 Subject: Fix [Bug 2712377]: [info vars] and object declared variables --- ChangeLog | 7 ++++++ generic/tclOO.c | 1 - generic/tclVar.c | 52 ++++++++++++++++++++++++++++++++++++---- tests/oo.test | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 127 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4c961d0..d66e5b7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2012-04-09 Donal K. Fellows + + * generic/tclVar.c (AppendLocals): [Bug 2712377]: Fix problem with + reporting of declared variables in methods. It's really a problem with + how [info vars] interacts with variable resolvers; this is just a bit + of a hack so it is no longer a big problem. + 2012-04-04 Donal K. Fellows * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance): 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/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); } /* diff --git a/tests/oo.test b/tests/oo.test index 8c5aeb3..a0e7345 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2946,6 +2946,78 @@ test oo-27.18 {variables declaration - multiple use} -setup { foo create bar list [bar boo] [bar boo] } -returnCodes error -match glob -result {unknown method "-?": must be *} +test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup { + oo::class create Foo + set result {} +} -body { + # This is really a test of problems to do with Tcl's introspection when a + # variable resolver is present... + oo::define Foo { + variable foo bar + method setvars {f b} { + set foo $f + set bar $b + } + method dump1 {} { + lappend ::result <1> + foreach v [lsort [info vars *]] { + lappend ::result $v=[set $v] + } + lappend ::result [info locals] [info locals *] + } + method dump2 {} { + lappend ::result <2> + foreach v [lsort [info vars *]] { + lappend ::result $v=[set $v] + } + lappend ::result | foo=$foo [info locals] [info locals *] + } + } + + Foo create stuff + stuff setvars what ever + stuff dump1 + stuff dump2 + return $result +} -cleanup { + Foo destroy +} -result {<1> bar=ever foo=what v v <2> bar=ever foo=what | foo=what v v} +test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup { + oo::class create Foo + set result {} +} -body { + # This is really a test of problems to do with Tcl's introspection when a + # variable resolver is present... + oo::define Foo { + variable foo bar + method setvars {f b} { + set foo $f + set bar $b + } + method dump1 {} { + lappend ::result <1> + foreach v [lsort [info vars *o]] { + lappend ::result $v=[set $v] + } + lappend ::result [info locals] [info locals *] + } + method dump2 {} { + lappend ::result <2> + foreach v [lsort [info vars *o]] { + lappend ::result $v=[set $v] + } + lappend ::result | foo=$foo [info locals] [info locals *] + } + } + + Foo create stuff + stuff setvars what ever + stuff dump1 + stuff dump2 + return $result +} -cleanup { + Foo destroy +} -result {<1> foo=what v v <2> foo=what | foo=what v v} # A feature that's not supported because the mechanism may change without # warning, but is supposed to work... -- cgit v0.12 From ba795792d6185008b4de5f9c0463f26fa2ddab0a Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 9 Apr 2012 21:38:27 +0000 Subject: Fix [Bug 3396896] --- ChangeLog | 4 ++++ generic/tclOODefineCmds.c | 52 ++++++++++++++++++++++++++++++++++++++++++----- tests/oo.test | 18 ++++++++++++++-- 3 files changed, 67 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index d66e5b7..c632c42 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2012-04-09 Donal K. Fellows + * generic/tclOODefineCmds.c (ClassVarsSet, ObjVarsSet): [Bug 3396896]: + Ensure that the lists of variable names used to drive variable + resolution will never have the same name twice. + * generic/tclVar.c (AppendLocals): [Bug 2712377]: Fix problem with reporting of declared variables in methods. It's really a problem with how [info vars] interacts with variable resolvers; this is just a bit 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 ; iclassPtr->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 ; ivariables.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/tests/oo.test b/tests/oo.test index a0e7345..f3c0bda 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2973,7 +2973,6 @@ test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup { lappend ::result | foo=$foo [info locals] [info locals *] } } - Foo create stuff stuff setvars what ever stuff dump1 @@ -3009,7 +3008,6 @@ test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup { lappend ::result | foo=$foo [info locals] [info locals *] } } - Foo create stuff stuff setvars what ever stuff dump1 @@ -3018,6 +3016,22 @@ test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup { } -cleanup { Foo destroy } -result {<1> foo=what v v <2> foo=what | foo=what v v} +test oo-27.21 {variables declaration uniqueifies: Bug 3396896} -setup { + oo::class create Foo +} -body { + oo::define Foo variable v v v t t v t + info class variable Foo +} -cleanup { + Foo destroy +} -result {v t} +test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup { + oo::object create foo +} -body { + oo::objdefine foo variable v v v t t v t + info object variable foo +} -cleanup { + foo destroy +} -result {v t} # A feature that's not supported because the mechanism may change without # warning, but is supposed to work... -- cgit v0.12