summaryrefslogtreecommitdiffstats
path: root/generic/tclEnv.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclEnv.c')
-rw-r--r--generic/tclEnv.c128
1 files changed, 38 insertions, 90 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 66ddb57..caa80f1 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -71,56 +71,36 @@ TclSetupEnv(
Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
- Var *varPtr, *arrayPtr;
- Tcl_Obj *varNamePtr;
Tcl_DString envString;
- Tcl_HashTable namesHash;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
+ char *p1, *p2;
+ int i;
/*
* Synchronize the values in the environ array with the contents of the
* Tcl "env" variable. To do this:
- * 1) Remove the trace that fires when the "env" var is updated.
- * 2) Find the existing contents of the "env", storing in a hash table.
- * 3) Create/update elements for each environ variable, removing
- * elements from the hash table as we go.
- * 4) Remove the elements for each remaining entry in the hash table,
- * which must have existed before yet have no analog in the environ
- * variable.
- * 5) Add a trace that synchronizes the "env" array.
+ * 1) Remove the trace that fires when the "env" var is unset.
+ * 2) Unset the "env" variable.
+ * 3) If there are no environ variables, create an empty "env" array.
+ * Otherwise populate the array with current values.
+ * 4) Add a trace that synchronizes the "env" array.
*/
Tcl_UntraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
- /*
- * Find out what elements are currently in the global env array.
- */
-
- TclNewLiteralStringObj(varNamePtr, "env");
- Tcl_IncrRefCount(varNamePtr);
- Tcl_InitObjHashTable(&namesHash);
- varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
- TclFindArrayPtrElements(varPtr, &namesHash);
-
- /*
- * Go through the environment array and transfer its values into Tcl. At
- * the same time, remove those elements we add/update from the hash table
- * of existing elements, so that after this part processes, that table
- * will hold just the parts to remove.
- */
+ Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
- if (environ[0] != NULL) {
- int i;
+ if (environ[0] == NULL) {
+ Tcl_Obj *varNamePtr;
+ TclNewLiteralStringObj(varNamePtr, "env");
+ Tcl_IncrRefCount(varNamePtr);
+ TclArraySet(interp, varNamePtr, NULL);
+ Tcl_DecrRefCount(varNamePtr);
+ } else {
Tcl_MutexLock(&envMutex);
for (i = 0; environ[i] != NULL; i++) {
- Tcl_Obj *obj1, *obj2;
- char *p1, *p2;
-
p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
p2 = strchr(p1, '=');
if (p2 == NULL) {
@@ -134,41 +114,12 @@ TclSetupEnv(
}
p2++;
p2[-1] = '\0';
- obj1 = Tcl_NewStringObj(p1, -1);
- obj2 = Tcl_NewStringObj(p2, -1);
+ Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&envString);
-
- Tcl_IncrRefCount(obj1);
- Tcl_IncrRefCount(obj2);
- Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
- hPtr = Tcl_FindHashEntry(&namesHash, obj1);
- if (hPtr != NULL) {
- Tcl_DeleteHashEntry(hPtr);
- }
- Tcl_DecrRefCount(obj1);
- Tcl_DecrRefCount(obj2);
}
Tcl_MutexUnlock(&envMutex);
}
- /*
- * Delete those elements that existed in the array but which had no
- * counterparts in the environment array.
- */
-
- for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
-
- TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
- }
- Tcl_DeleteHashTable(&namesHash);
- Tcl_DecrRefCount(varNamePtr);
-
- /*
- * Re-establish the trace.
- */
-
Tcl_TraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
@@ -202,8 +153,7 @@ TclSetEnv(
const char *value) /* New value for variable (UTF-8). */
{
Tcl_DString envString;
- unsigned nameLength, valueLength;
- int index, length;
+ int index, length, nameLength;
char *p, *oldValue;
const char *p2;
@@ -225,11 +175,12 @@ TclSetEnv(
*/
if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
- char **newEnviron = ckalloc((length + 5) * sizeof(char *));
+ char **newEnviron = (char **)
+ ckalloc(((unsigned) length + 5) * sizeof(char *));
memcpy(newEnviron, environ, length * sizeof(char *));
if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
- ckfree(env.ourEnviron);
+ ckfree((char *) env.ourEnviron);
}
environ = env.ourEnviron = newEnviron;
env.ourEnvironSize = length + 5;
@@ -259,7 +210,7 @@ TclSetEnv(
Tcl_DStringFree(&envString);
oldValue = environ[index];
- nameLength = (unsigned) length;
+ nameLength = length;
}
/*
@@ -268,19 +219,18 @@ TclSetEnv(
* and set the environ array value.
*/
- valueLength = strlen(value);
- p = ckalloc(nameLength + valueLength + 2);
- memcpy(p, name, nameLength);
+ p = ckalloc((unsigned) nameLength + strlen(value) + 2);
+ strcpy(p, name);
p[nameLength] = '=';
- memcpy(p+nameLength+1, value, valueLength+1);
+ strcpy(p+nameLength+1, value);
p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
/*
* Copy the native string to heap memory.
*/
- p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
- memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
+ p = ckrealloc(p, strlen(p2) + 1);
+ strcpy(p, p2);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
@@ -439,21 +389,20 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
-#if defined(_WIN32)
- string = ckalloc(length + 2);
+#if defined(__WIN32__)
+ string = ckalloc((unsigned) length+2);
memcpy(string, name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
#else
- string = ckalloc(length + 1);
+ string = ckalloc((unsigned) length+1);
memcpy(string, name, (size_t) length);
string[length] = '\0';
-#endif /* _WIN32 */
+#endif /* WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
- string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
- memcpy(string, Tcl_DStringValue(&envString),
- (unsigned) Tcl_DStringLength(&envString)+1);
+ string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
+ strcpy(string, Tcl_DStringValue(&envString));
Tcl_DStringFree(&envString);
putenv(string);
@@ -551,8 +500,7 @@ TclGetEnv(
* array.
*
* Results:
- * Returns NULL to indicate success, or an error-message if the array
- * element being handled doesn't exist.
+ * Always returns NULL to indicate success.
*
* Side effects:
* Environment variable changes get propagated. If the whole "env" array
@@ -610,7 +558,7 @@ EnvTraceProc(
const char *value = TclGetEnv(name2, &valueString);
if (value == NULL) {
- return (char *) "no such variable";
+ return "no such variable";
}
Tcl_SetVar2(interp, name1, name2, value, 0);
Tcl_DStringFree(&valueString);
@@ -687,11 +635,11 @@ ReplaceString(
const int growth = 5;
- env.cache = ckrealloc(env.cache,
+ env.cache = (char **) ckrealloc((char *) env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
- (void) memset(env.cache+env.cacheSize+1, 0,
- (size_t) (growth-1) * sizeof(char *));
+ (void) memset(env.cache+env.cacheSize+1, (int) 0,
+ (size_t) (growth-1) * sizeof(char*));
env.cacheSize += growth;
}
}
@@ -726,7 +674,7 @@ TclFinalizeEnvironment(void)
*/
if (env.cache) {
- ckfree(env.cache);
+ ckfree((char *) env.cache);
env.cache = NULL;
env.cacheSize = 0;
#ifndef USE_PUTENV
generated by cgit v0.12 at 2025-12-18 13:09:53 (GMT)