ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.11

Browse Source
This commit is contained in:
Steve Dower
2021-03-30 00:51:39 +01:00
parent 3bb8e3e086
commit 1aadb2455c
923 changed files with 79104 additions and 62616 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
generic/tclEnv.c
View File

@@ -17,12 +17,31 @@
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
#if defined(_WIN32)
# define tenviron _wenviron
# define tenviron2utfdstr(tenvstr, len, dstr) \
Tcl_WinTCharToUtf((TCHAR *)tenvstr, len, dstr)
# define utf2tenvirondstr(str, len, dstr) \
(const WCHAR *)Tcl_WinUtfToTChar(str, len, dstr)
# define techar WCHAR
# ifdef USE_PUTENV
# define putenv(env) _wputenv((const wchar_t *)env)
# endif
#else
# define tenviron environ
# define tenviron2utfdstr(tenvstr, len, dstr) \
Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
# define utf2tenvirondstr(str, len, dstr) \
Tcl_UtfToExternalDString(NULL, str, len, dstr)
# define techar char
#endif
static struct {
int cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
char **ourEnviron; /* Cache of the array that we allocate. We
techar **ourEnviron; /* Cache of the array that we allocate. We
* need to track this in case another
* subsystem swaps around the environ array
* like we do. */
@@ -34,6 +53,8 @@ static struct {
#endif
} env;
#define tNTL sizeof(techar)
/*
* Declarations for local functions defined in this file:
*/
@@ -106,6 +127,17 @@ TclSetupEnv(
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
TclFindArrayPtrElements(varPtr, &namesHash);
#if defined(_WIN32)
if (tenviron == NULL) {
/*
* When we are started from main(), the _wenviron array could
* be NULL and will be initialized by the first _wgetenv() call.
*/
(void) _wgetenv(L"WINDIR");
}
#endif
/*
* 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
@@ -113,17 +145,17 @@ TclSetupEnv(
* will hold just the parts to remove.
*/
if (environ[0] != NULL) {
if (tenviron[0] != NULL) {
int i;
Tcl_MutexLock(&envMutex);
for (i = 0; environ[i] != NULL; i++) {
for (i = 0; tenviron[i] != NULL; i++) {
Tcl_Obj *obj1, *obj2;
const char *p1;
char *p2;
p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
p2 = strchr(p1, '=');
p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
p2 = (char *)strchr(p1, '=');
if (p2 == NULL) {
/*
* This condition seem to happen occasionally under some
@@ -172,7 +204,7 @@ TclSetupEnv(
for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
hPtr=Tcl_NextHashEntry(&search)) {
Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
Tcl_Obj *elemName = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
}
@@ -219,7 +251,7 @@ TclSetEnv(
unsigned nameLength, valueLength;
int index, length;
char *p, *oldValue;
const char *p2;
const techar *p2;
/*
* Figure out where the entry is going to go. If the name doesn't already
@@ -238,23 +270,23 @@ TclSetEnv(
* environment is the one we allocated. [Bug 979640]
*/
if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
char **newEnviron = ckalloc((length + 5) * sizeof(char *));
if ((env.ourEnviron != tenviron) || (length+2 > env.ourEnvironSize)) {
techar **newEnviron = (techar **)ckalloc((length + 5) * sizeof(techar *));
memcpy(newEnviron, environ, length * sizeof(char *));
memcpy(newEnviron, tenviron, length * sizeof(techar *));
if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
ckfree(env.ourEnviron);
}
environ = env.ourEnviron = newEnviron;
tenviron = (env.ourEnviron = newEnviron);
env.ourEnvironSize = length + 5;
}
index = length;
environ[index + 1] = NULL;
tenviron[index + 1] = NULL;
#endif /* USE_PUTENV */
oldValue = NULL;
nameLength = strlen(name);
} else {
const char *env;
const char *oldEnv;
/*
* Compare the new value to the existing value. If they're the same
@@ -264,16 +296,16 @@ TclSetEnv(
* interpreters.
*/
env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
if (strcmp(value, env + (length + 1)) == 0) {
oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
if (strcmp(value, oldEnv + (length + 1)) == 0) {
Tcl_DStringFree(&envString);
Tcl_MutexUnlock(&envMutex);
return;
}
Tcl_DStringFree(&envString);
oldValue = environ[index];
nameLength = (unsigned) length;
oldValue = (char *)tenviron[index];
nameLength = length;
}
/*
@@ -283,18 +315,18 @@ TclSetEnv(
*/
valueLength = strlen(value);
p = ckalloc(nameLength + valueLength + 2);
p = (char *)ckalloc(nameLength + valueLength + 2);
memcpy(p, name, nameLength);
p[nameLength] = '=';
memcpy(p+nameLength+1, value, valueLength+1);
p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
p2 = utf2tenvirondstr(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 = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + tNTL);
memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
@@ -305,7 +337,7 @@ TclSetEnv(
putenv(p);
index = TclpFindVariable(name, &length);
#else
environ[index] = p;
tenviron[index] = (techar *)p;
#endif /* USE_PUTENV */
/*
@@ -314,7 +346,7 @@ TclSetEnv(
* string in the cache.
*/
if ((index != -1) && (environ[index] == p)) {
if ((index != -1) && (tenviron[index] == (techar *)p)) {
ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
@@ -379,7 +411,7 @@ Tcl_PutEnv(
*/
name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
value = strchr(name, '=');
value = (char *)strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
@@ -440,7 +472,7 @@ TclUnsetEnv(
* Remember the old value so we can free it if Tcl created the string.
*/
oldValue = environ[index];
oldValue = (char *)tenviron[index];
/*
* Update the system environment. This must be done before we update the
@@ -454,20 +486,20 @@ TclUnsetEnv(
*/
#if defined(_WIN32)
string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string = (char *)ckalloc(length + 2);
memcpy(string, name, length);
string[length] = '=';
string[length+1] = '\0';
#else
string = ckalloc(length + 1);
memcpy(string, name, (size_t) length);
string = (char *)ckalloc(length + 1);
memcpy(string, name, length);
string[length] = '\0';
#endif /* _WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
utf2tenvirondstr(string, -1, &envString);
string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL);
memcpy(string, Tcl_DStringValue(&envString),
(unsigned) Tcl_DStringLength(&envString)+1);
Tcl_DStringLength(&envString) + tNTL);
Tcl_DStringFree(&envString);
putenv(string);
@@ -478,7 +510,7 @@ TclUnsetEnv(
* string in the cache.
*/
if (environ[index] == string) {
if (tenviron[index] == (techar *)string) {
ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
@@ -490,7 +522,7 @@ TclUnsetEnv(
#endif /* HAVE_PUTENV_THAT_COPIES */
}
#else /* !USE_PUTENV_FOR_UNSET */
for (envPtr = environ+index+1; ; envPtr++) {
for (envPtr = (char **)(tenviron+index+1); ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
break;
@@ -539,7 +571,7 @@ TclGetEnv(
if (index != -1) {
Tcl_DString envStr;
result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
result = tenviron2utfdstr(tenviron[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
@@ -701,7 +733,7 @@ ReplaceString(
const int growth = 5;
env.cache = ckrealloc(env.cache,
env.cache = (char **)ckrealloc(env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
(void) memset(env.cache+env.cacheSize+1, 0,